以特定方式使用 VBA 搜索 Excel

Question

我想创建一个 excel 宏来搜索工作表并根据单元格内的值突出显示单元格和单元格之间。

For each Column in sheet
   For Each Cell in Column
      val = Cell.Value
      valAddress = Cell.Address
      
      If val == ("=<") AND ActiveCell.Colour == NOT green
         startSelect = valAddress

      ElseIf val == ("==") AND ActiveCell.Colour == NOT green
         set cell.colour = green

      ElseIf val == (">") AND startSelect == NOT Nothing AND ActiveCell.Colour == NOT green
         Select Cells From startSelect to Active.Cell
         Set Cell.Colour = Green
         val = 0
         startSelect = NULL
         valaddress = 0 

      ElseIf Cell == Final Cell in Column and startSelect == NOT Nothing
         Select Cells From startSelect to Active.Cell
         Set Cell.Colour = Green
         val = 0
         startSelect = NULL
         valaddress = 0

我试图在实际的 VBA 中写这个，但收效甚微。有谁知道如何向下搜索每一列以及如何找出何时位于工作表底部？

我基本上想重新创建附加照片中的突出显示，但创建一个自动突出显示的程序。

结果：

提前谢谢了！！

请参阅下面的尝试

Sub btnFillTableColour()

Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim row As Integer
Dim cellValue As String

For i = 6 To 196
    For j = 7 To 305
        cellValue = Cells(i, j)
        If cellValue = (">=") And ws.Cells(i, j).Interior.Color = RGB(0, 0, 0) Then
            row = j
            col = i
            cellValue = 0
        ElseIf cellValue = ("==") And ws.Cells(i, j).Interior.Color = RGB(0, 0, 0) Then
            Cells(i, j).Interior.Color = vbGreen
            cellValue = 0
        ElseIf cellValue = ("<") And ws.Cells(i, j).Interior.Color = RGB(0, 0, 0) Then
            For k = row To j
                Cells(k, j).Interior.Color = vbGreen
            Next k
            k = 0
            row = 0
            cellValue = 0
            
        ElseIf j = 304 And ws.Cells(i, j).Interior.Color = RGB(0, 0, 0) And row > 0 Then
            For k = row To j
                Cells(k, j).Interior.Color = vbGreen
            Next k
            k = 0
            row = 0
            cellValue = 0
    Next j
Next i

End Sub

Answer 1

如果我理解正确的话...

开始条件和预期结果就像上面的动画。

因此，如果上面的动画与您的期望相似......

Sub test()
Dim colCount As Integer: Dim col As Integer
Dim rg As Range: Dim rg1 As Range: Dim rg2 As Range
Dim arr1: Dim arr2: Dim i As Integer: Dim cnt As Integer

'get how many columns of the header range as colCount variable - change as needed
colCount = Range("A1", Range("A1").End(xlToRight)).Columns.Count

'loop to each column of the header
For col = 1 To colCount

'set the range of data in the looped column as rg variable
    Set rg = Range(Cells(1, col), Cells(Rows.Count, col).End(xlUp))
    
'set the range which has >= as rg1 varibale and which has < as rg2 variable
    With rg
        .Replace ">=", True, xlWhole, , False, , False, False
        Set rg1 = .SpecialCells(xlConstants, xlLogical)
        .Replace True, ">=", xlWhole, , False, , False, False
        .Replace "<", True, xlWhole, , False, , False, False
        Set rg2 = .SpecialCells(xlConstants, xlLogical)
        .Replace True, "<", xlWhole, , False, , False, False
    End With

'get how many constant value are there in rg1 as cnt variable
'and check if it's the same with the count of constant value in rg2
'then get both rg1 and rg2 address as arr1 and arr2 variable
'then finally loop as many as the count value
'and apply the color according to the header color of the respective column
    cnt = Application.CountA(rg1)
        If cnt = Application.CountA(rg2) Then
            arr1 = Split(rg1.Address, ",")
            arr2 = Split(rg2.Address, ",")
                For i = 0 To cnt - 1
                    Range(arr1(i), arr2(i)).Interior.Color = Cells(1, col).Interior.Color
                Next
        End If
Next

End Sub

该代码假定每个标题列已经具有背景颜色，因此 >= 和 < 之间的每个范围的颜色与相应列的标题颜色相同。

该代码还假定每列中不会连续出现“>=”或“<”。所以，不会有这样的东西（例如）：单元格 A1 值“>=”，单元格 A10 值“>=”，然后“<”的第一次出现在单元格 A13 中。

如果在每一列中，“>=”的存在计数与“<”的计数不同，则代码将失败。