从Range.Areas的每个单元格中获取值

Question

我有这样的代码，我得到了这里

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。

它似乎有一个相当简单的解决方案，但我尝试了它的工作，就像我与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