循环遍历行并为每行应用不同的条件格式

时间:2018-01-18 12:32:45

标签: excel vba excel-vba loops

此脚本查找行中第一列中的值,在第二个工作表中查找相应的值,并从第二个工作表中同一行的其他列中获取值。然后,它根据从第二张表中检索到的值对第一张表中的值应用条件格式。

但是,我一次只能在一行上工作,我不想重复第一张表中所有行的代码。如何遍历第一张表中的所有行并对剩余的行执行相同的操作?

Sub Vlookup4()

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

    FndStr = Range("A10").Value

    Set FndVal = Worksheets("Grenseverdier_jord").Columns("A:A").Find(What:=FndStr, LookAt:=xlWhole)
        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

    Set FndRng = Range(Cells(10, 3), Cells(10, Cells(10, Columns.Count).End(xlToLeft).Column))

    Debug.Print FndRng.Address

    With ActiveSheet

        With FndRng
            .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C10);C10<" & Ul1 & ")"
            .FormatConditions(1).Interior.ColorIndex = 33
            .FormatConditions(1).Borders.LineStyle = xlContinuous
            .FormatConditions(1).Borders.Weight = xlThin

            .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C10);C10>=" & Ul1 & ";C10<" & Ul2 & ")"
            .FormatConditions(2).Interior.ColorIndex = 4
            .FormatConditions(2).Borders.LineStyle = xlContinuous
            .FormatConditions(2).Borders.Weight = xlThin

            .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C10);C10>=" & Ul2 & ";C10<" & Ul3 & ")"
            .FormatConditions(3).Interior.ColorIndex = 6
            .FormatConditions(3).Borders.LineStyle = xlContinuous
            .FormatConditions(3).Borders.Weight = xlThin

            .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C10);C10>=" & Ul3 & ";C10<" & Ul4 & ")"
            .FormatConditions(4).Interior.ColorIndex = 45
            .FormatConditions(4).Borders.LineStyle = xlContinuous
            .FormatConditions(4).Borders.Weight = xlThin

            .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C10);C10>=" & Ul4 & ";C10<" & Ul5 & ")"
            .FormatConditions(5).Borders.LineStyle = xlContinuous
            .FormatConditions(5).Borders.Weight = xlThin
            .FormatConditions(5).Interior.ColorIndex = 3

            .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C10);C10>=" & Ul5 & ")"
            .FormatConditions(6).Interior.ColorIndex = 7
            .FormatConditions(6).Borders.LineStyle = xlContinuous
            .FormatConditions(6).Borders.Weight = xlThin

            .FormatConditions.Add xlExpression, Formula1:="=LEFT(C10;1)=""<"""
            .FormatConditions(7).Interior.ColorIndex = 33
            .FormatConditions(7).Borders.LineStyle = xlContinuous
            .FormatConditions(7).Borders.Weight = xlThin

            .FormatConditions.Add xlExpression, Formula1:="=(C10) = ""n.d."""
            .FormatConditions(8).Interior.ColorIndex = 33
            .FormatConditions(8).Borders.LineStyle = xlContinuous
            .FormatConditions(8).Borders.Weight = xlThin

        End With
        End With
End Sub

我附上了一个样本文件进行测试。

Sample file

1 个答案:

答案 0 :(得分:1)

这应该适合你:

Sub Vlookup4()

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
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A

For i = 10 To LastRow
    FndStr = ws.Range("A" & i).Value

    Set FndVal = Worksheets("Grenseverdier_jord").Columns("A:A").Find(What:=FndStr, LookAt:=xlWhole)
        If Not FndVal Is Nothing Then
                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

            Set FndRng = ws.Range("C" & i & ":I" & i)

            With ActiveSheet

                With FndRng

                    .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C " & i & ");C " & i & "<" & Ul1 & ")"
                    .FormatConditions(1).Interior.ColorIndex = 33
                    .FormatConditions(1).Borders.LineStyle = xlContinuous
                    .FormatConditions(1).Borders.Weight = xlThin

                    .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C " & i & ");C " & i & ">=" & Ul1 & ";C " & i & "<" & Ul2 & ")"
                    .FormatConditions(2).Interior.ColorIndex = 4
                    .FormatConditions(2).Borders.LineStyle = xlContinuous
                    .FormatConditions(2).Borders.Weight = xlThin

                    .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C " & i & ");C " & i & ">=" & Ul2 & ";C " & i & "<" & Ul3 & ")"
                    .FormatConditions(3).Interior.ColorIndex = 6
                    .FormatConditions(3).Borders.LineStyle = xlContinuous
                    .FormatConditions(3).Borders.Weight = xlThin

                    .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C " & i & ");C " & i & ">=" & Ul3 & ";C " & i & "<" & Ul4 & ")"
                    .FormatConditions(4).Interior.ColorIndex = 45
                    .FormatConditions(4).Borders.LineStyle = xlContinuous
                    .FormatConditions(4).Borders.Weight = xlThin

                    .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C " & i & ");C " & i & ">=" & Ul4 & ";C " & i & "<" & Ul5 & ")"
                    .FormatConditions(5).Borders.LineStyle = xlContinuous
                    .FormatConditions(5).Borders.Weight = xlThin
                    .FormatConditions(5).Interior.ColorIndex = 3

                    .FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(C " & i & ");C " & i & ">=" & Ul5 & ")"
                    .FormatConditions(6).Interior.ColorIndex = 7
                    .FormatConditions(6).Borders.LineStyle = xlContinuous
                    .FormatConditions(6).Borders.Weight = xlThin

                    .FormatConditions.Add xlExpression, Formula1:="=LEFT(C " & i & ";1)=""<"""
                    .FormatConditions(7).Interior.ColorIndex = 33
                    .FormatConditions(7).Borders.LineStyle = xlContinuous
                    .FormatConditions(7).Borders.Weight = xlThin

                    .FormatConditions.Add xlExpression, Formula1:="=(C " & i & ") = ""n.d."""
                    .FormatConditions(8).Interior.ColorIndex = 33
                    .FormatConditions(8).Borders.LineStyle = xlContinuous
                    .FormatConditions(8).Borders.Weight = xlThin
                End With
            End With
        End If
Next i
End Sub

我添加了一行来查找LastRow,然后使用For循环遍历每一行,我还添加了If Not FndVal Is Nothing Then以确保在另一行中找不到任何内容表格不会导致错误。