此脚本查找行中第一列中的值,在第二个工作表中查找相应的值,并从第二个工作表中同一行的其他列中获取值。然后,它根据从第二张表中检索到的值对第一张表中的值应用条件格式。
但是,我一次只能在一行上工作,我不想重复第一张表中所有行的代码。如何遍历第一张表中的所有行并对剩余的行执行相同的操作?
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
我附上了一个样本文件进行测试。
答案 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
以确保在另一行中找不到任何内容表格不会导致错误。