Получение значения из каждой ячейки Range.Areas

Question

Я этот код, который я получил here

Sub QuickMap() 

    Dim FormulaCells 
    Dim TextCells 
    Dim NumberCells 
    Dim Area 

    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub 

' Create object variables for cell subsets 
    On Error Resume Next 
    Set FormulaCells = Range("A1").SpecialCells _ 
     (xlFormulas, xlNumbers + xlTextValues + xlLogical) 
    Set TextCells = Range("A1").SpecialCells(xlConstants, xlTextValues) 
    Set NumberCells = Range("A1").SpecialCells(xlConstants, xlNumbers) 
    On Error GoTo 0 

' Add a new sheet and format it 
    Sheets.Add 
    With Cells 
     .ColumnWidth = 2 
     .Font.Size = 8 
     .HorizontalAlignment = xlCenter 
    End With 

    Application.ScreenUpdating = False 

' Do the formula cells 
    If Not IsEmpty(FormulaCells) Then 
     For Each Area In FormulaCells.Areas 
      With ActiveSheet.Range(Area.Address) 
       .value = "F" 
       .Interior.ColorIndex = 3 
      End With 
     Next Area 
    End If 

' Do the text cells 
    If Not IsEmpty(TextCells) Then 
     For Each Area In TextCells.Areas 
      With ActiveSheet.Range(Area.Address) 
       .value = "T" 
       .Interior.ColorIndex = 4 
      End With 
     Next Area 
    End If 

' Do the numeric cells 
    If Not IsEmpty(NumberCells) Then 
     For Each Area In NumberCells.Areas 
      With ActiveSheet.Range(Area.Address) 
       .value = "N" 
       .Interior.ColorIndex = 6 
      End With 
     End If 
     Next Area 
    End If 
End Sub 

Что делает этот код является создание новой worksheet с картой другого worksheet, например, поместить N с желтым цветом фона, где число или константа на другом листе.

Я хочу, чтобы установить цвет фона на синий в клетках на карте, где значение на другом листе является числовым и больше 130.

Это seens иметь довольно простое решение, но я попробовал работать с ним, как я работаю с Ranges, но я не получаю удовлетворительных результатов.

Итак, мой вопрос: как я могу получить значение каждой ячейки для использования оператора условия? Заранее спасибо.

Answer 1

Вы можете элемент контура на .area затем, если один элемент, соответствующий текстовый фон ячейки будет синий иначе желтый

Sub QuickMap() 
     Dim FormulaCells 
     Dim TextCells 
     Dim NumberCells 
     Dim Area 

     If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub 

    ' Create object variables for cell subsets 
     On Error Resume Next 
     Set FormulaCells = Range("A1").SpecialCells _ 
      (xlFormulas, xlNumbers + xlTextValues + xlLogical) 
     Set TextCells = Range("A1").SpecialCells(xlConstants, xlTextValues) 
     Set NumberCells = Range("A1").SpecialCells(xlConstants, xlNumbers) 
     On Error GoTo 0 

    ' Add a new sheet and format it 
     Sheets.Add 
     With Cells 
      .ColumnWidth = 2 
      .Font.Size = 8 
      .HorizontalAlignment = xlCenter 
     End With 

     Application.ScreenUpdating = False 

    ' Do the formula cells 
     If Not IsEmpty(FormulaCells) Then 
      For Each Area In FormulaCells.Areas 
       With ActiveSheet.Range(Area.Address) 
        .Value = "F" 
        .Interior.ColorIndex = 3 
       End With 
      Next Area 
     End If 

    ' Do the text cells 
     If Not IsEmpty(TextCells) Then 
      For Each Area In TextCells.Areas 
       With ActiveSheet.Range(Area.Address) 
        .Value = "T" 
        .Interior.ColorIndex = 4 
       End With 
      Next Area 
     End If 

    ' Do the numeric cells 
     If Not IsEmpty(NumberCells) Then 
      For Each Area In NumberCells.Areas 
       For Each Item In Area 
        If Item > 130 Then 
         ActiveSheet.Range(Item.Address).Value = "N" 
         ActiveSheet.Range(Item.Address).Interior.ColorIndex = 5 
        Else 
         ActiveSheet.Range(Item.Address).Value = "N" 
         ActiveSheet.Range(Item.Address).Interior.ColorIndex = 6 
        End If 
       Next Item 
      Next Area 
     End If 
    End Sub