Question

所以我得到了这个vba来过滤空白并根据值＆lt; 4填充红色列。我现在想要过滤3个额外的列，我需要搜索工作簿并填充小于红色的值，因此声明3个以上的范围

Sub test()
  Dim SearchCol As String
  Dim rng1 As Range
  Dim rng2 As Range
  Dim ws As Worksheet

SearchCol = "ID"

For Each ws In Worksheets
    Set rng1 = ws.UsedRange.Find(SearchCol, , xlValues, xlWhole)
    Set rng2 = ws.UsedRange.Find("Amount", , xlValues, xlWhole)
    If Not rng1 Is Nothing Then
        With ws
            .Range("A2").AutoFilter field:=rng1.Column, Criteria1:="<>"
            .Range("A2").AutoFilter field:=rng2.Column, Criteria1:="<4"
            On Error Resume Next
            lastRow = .Cells(.Rows.Count, rng2.Column).End(xlUp).Row
            .Range(.Cells(rng2.Row + 1, rng2.Column), .Cells(lastRow, rng2.Column)).SpecialCells(xlCellTypeVisible).Interior.Color = RGB(255, 0, 0)
            On Error GoTo 0
        End With
    End If
Next ws
End Sub

Answer 1

这是你需要的吗？

Sub test()
    Dim col1Name As String, colName(2 To 5) As String
    Dim rng1 As Range, rng(2 To 5) As Range
    Dim ws As Worksheet
    Dim lastrow As Integer
    Dim restrictions(2 To 5) As String


    On Error Resume Next

    col1Name = "ID"
    colName(2) = "Amount"
    colName(3) = "test1"
    colName(4) = "test2"
    colName(5) = "test3"

    restrictions(2) = "<4"
    restrictions(3) = "<4"
    restrictions(4) = "<4"
    restrictions(5) = "<4"

    For Each ws In Worksheets

        With ws

            For i = 2 To 5
                ws.AutoFilterMode = False
                Set rng1 = .UsedRange.Find(col1Name, , xlValues, xlWhole)
                Set rng(i) = .UsedRange.Find(colName(i), , xlValues, xlWhole)

                If Not rng1 Is Nothing Then .Range("A2").AutoFilter field:=rng1.Column, Criteria1:="<>"
                If Not rng(i) Is Nothing Then
                    .Range("A2").AutoFilter field:=rng(i).Column, Criteria1:=restrictions(i)
                    lastrow = .Cells(.Rows.Count, rng(i).Column).End(xlUp).Row
                    .Range(.Cells(rng(i).Row + 1, rng(i).Column), .Cells(lastrow, rng(i).Column).Address).SpecialCells(xlCellTypeVisible).Interior.Color = RGB(255, 0, 0)
                End If
            Next i

        End With
    Next ws
End Sub

循环遍历大量搜索的列和填充值

1 个答案: