如何用VBA循环遍历Excel行批量应用条件格式

Got it, let's turn your single-row VBA script into a batch-processing tool that works for every row in your active worksheet. I'll refactor the code with a loop, add error handling for missing matches, and clean up redundant code to make it maintainable.

Key Improvements Made: #

• Loop through all data rows: Automatically detects the last row with data in column A and processes each one
• Error handling: Skips rows where no match is found in the Grenseverdier_jord sheet to avoid runtime errors
• Clean up existing formats: Removes old conditional formats before applying new ones to prevent buildup
• Reduced redundancy: Keeps the conditional format logic consistent across all rows without repeating code

Modified Full Code #

Sub BatchVlookupConditionalFormatting()
    Dim wsActive As Worksheet
    Dim wsLookup As Worksheet
    Dim lastRow As Long
    Dim currentRow As Long
    Dim FndStr As String
    Dim FndVal As Range
    Dim FndRng As Range
    Dim Ul1 As Double, Ul2 As Double, Ul3 As Double, Ul4 As Double, Ul5 As Double
    
    ' Set worksheet references (adjust names if needed)
    Set wsActive = ActiveSheet
    Set wsLookup = ThisWorkbook.Worksheets("Grenseverdier_jord")
    
    ' Get last row with data in column A of active sheet
    lastRow = wsActive.Cells(wsActive.Rows.Count, "A").End(xlUp).Row
    
    ' Loop through each row (start at row 2 if row 1 is header; adjust as needed)
    For currentRow = 2 To lastRow
        ' Get the lookup value from column A of current row
        FndStr = wsActive.Cells(currentRow, "A").Value
        
        ' Skip empty cells in column A
        If FndStr = "" Then GoTo NextRow
        
        ' Find the matching row in lookup sheet
        Set FndVal = wsLookup.Columns("A:A").Find(What:=FndStr, LookAt:=xlWhole)
        
        ' Handle case where no match is found
        If FndVal Is Nothing Then
            Debug.Print "No match found for: " & FndStr & " in row " & currentRow
            GoTo NextRow
        End If
        
        ' Get threshold values from lookup sheet
        Ul1 = FndVal.Offset(0, 1).Value
        Ul2 = FndVal.Offset(0, 2).Value
        Ul3 = FndVal.Offset(0, 3).Value
        Ul4 = FndVal.Offset(0, 4).Value
        Ul5 = FndVal.Offset(0, 5).Value
        
        ' Define the range to apply conditional formatting (columns C to last used column in current row)
        Set FndRng = wsActive.Range(wsActive.Cells(currentRow, "C"), wsActive.Cells(currentRow, wsActive.Cells(currentRow, wsActive.Columns.Count).End(xlToLeft).Column))
        
        ' Clear existing conditional formats for this range to avoid duplicates
        FndRng.FormatConditions.Delete
        
        ' Apply conditional formatting rules
        With FndRng
            ' Rule 1: Value < Ul1
            .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & .Cells(1).Address(False, False) & ");" & .Cells(1).Address(False, False) & "<" & Ul1 & ")"
            With .FormatConditions(.FormatConditions.Count)
                .Interior.ColorIndex = 33
                .Borders.LineStyle = xlContinuous
                .Borders.Weight = xlThin
            End With
            
            ' Rule 2: Ul1 <= Value < Ul2
            .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & .Cells(1).Address(False, False) & ");" & .Cells(1).Address(False, False) & ">=" & Ul1 & ";" & .Cells(1).Address(False, False) & "<" & Ul2 & ")"
            With .FormatConditions(.FormatConditions.Count)
                .Interior.ColorIndex = 4
                .Borders.LineStyle = xlContinuous
                .Borders.Weight = xlThin
            End With
            
            ' Rule 3: Ul2 <= Value < Ul3
            .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & .Cells(1).Address(False, False) & ");" & .Cells(1).Address(False, False) & ">=" & Ul2 & ";" & .Cells(1).Address(False, False) & "<" & Ul3 & ")"
            With .FormatConditions(.FormatConditions.Count)
                .Interior.ColorIndex = 6
                .Borders.LineStyle = xlContinuous
                .Borders.Weight = xlThin
            End With
            
            ' Rule 4: Ul3 <= Value < Ul4
            .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & .Cells(1).Address(False, False) & ");" & .Cells(1).Address(False, False) & ">=" & Ul3 & ";" & .Cells(1).Address(False, False) & "<" & Ul4 & ")"
            With .FormatConditions(.FormatConditions.Count)
                .Interior.ColorIndex = 45
                .Borders.LineStyle = xlContinuous
                .Borders.Weight = xlThin
            End With
            
            ' Rule 5: Ul4 <= Value < Ul5
            .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & .Cells(1).Address(False, False) & ");" & .Cells(1).Address(False, False) & ">=" & Ul4 & ";" & .Cells(1).Address(False, False) & "<" & Ul5 & ")"
            With .FormatConditions(.FormatConditions.Count)
                .Interior.ColorIndex = 3
                .Borders.LineStyle = xlContinuous
                .Borders.Weight = xlThin
            End With
            
            ' Rule 6: Value >= Ul5
            .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & .Cells(1).Address(False, False) & ");" & .Cells(1).Address(False, False) & ">=" & Ul5 & ")"
            With .FormatConditions(.FormatConditions.Count)
                .Interior.ColorIndex = 7
                .Borders.LineStyle = xlContinuous
                .Borders.Weight = xlThin
            End With
            
            ' Rule 7: Value starts with "<"
            .FormatConditions.Add xlExpression, Formula1:="=LEFT(" & .Cells(1).Address(False, False) & ";1)=""<"""
            With .FormatConditions(.FormatConditions.Count)
                .Interior.ColorIndex = 33
                .Borders.LineStyle = xlContinuous
                .Borders.Weight = xlThin
            End With
            
            ' Rule 8: Value is "n.d."
            .FormatConditions.Add xlExpression, Formula1:="=" & .Cells(1).Address(False, False) & "=""n.d."""
            With .FormatConditions(.FormatConditions.Count)
                .Interior.ColorIndex = 33
                .Borders.LineStyle = xlContinuous
                .Borders.Weight = xlThin
            End With
        End With
        
NextRow:
    Next currentRow
    
    MsgBox "Batch conditional formatting completed!", vbInformation
End Sub

How It Works: #

1. Worksheet References: We explicitly define the active sheet and lookup sheet to avoid confusion if you switch sheets while running the script.
2. Row Detection: lastRow finds the last row with data in column A, so we don't waste time looping through empty rows.
3. Loop Logic: The For currentRow = 2 To lastRow loop processes each row (start at row 2 if your first row is a header—adjust this number if your data starts elsewhere).
4. Error Handling: If a value in column A has no match in Grenseverdier_jord, the script logs a message to the Immediate Window and moves to the next row instead of crashing.
5. Dynamic Range: FndRng automatically adjusts to the last used column in each row, so it works even if some rows have more columns than others.
6. Clean Formatting: We delete existing conditional formats for each range before adding new ones to prevent overlapping, messy rules.
7. Relative Formulas: Instead of hardcoding C10, we use .Cells(1).Address(False, False) to create a relative reference that works for any row.

内容的提问来源于stack exchange，提问作者LarsS