Question

目前，我的Excel VBA脚本会在 main.xlsm 中搜索列J进行匹配，如果找到与 vda.xlsx 的A列匹配，则会突出显示红色的文字。如何在 main.xlsm 中搜索J-L列？

Sub VDA_Update()

Dim wshT As Worksheet
    Dim wbk As Workbook
    Dim wshS As Worksheet
    Dim r As Long
    Dim m As Long
    Dim cel As Range
    Application.ScreenUpdating = False
    Set wshT = ThisWorkbook.Worksheets("Master")
    On Error Resume Next

    ' Check whether vda.xlsx is already open
    Set wbk = Workbooks("vda.xlsx")
        On Error GoTo 0
        If wbk Is Nothing Then
        ' If not, open it
        Set wbk = Workbooks.Open("C:\Working\vda_test.xlsx")
    End If

    ' Set worksheet on vda.xlsx
    Set wshS = wbk.Worksheets("imac01")
    m = wshT.Cells(wshT.Rows.Count, 1).End(xlUp).Row

    ' Loop though cells in column J on main.xlsm
    For r = 1 To m

        ' Can we find the value in column A of vda.xlsx?

        Set cel = wshS.Columns(1).Find(What:="TEST\" + wshT.Cells(r, 10).Value, _
        LookAt:=xlWhole, MatchCase:=False)

        If Not cel Is Nothing Then

            MsgBox wshS.Cells(r, 1)

            ' If we find a match, then change the text to red
            wshT.Cells(r, 10).Font.ColorIndex = 3

        End If
    Next r

    Application.ScreenUpdating = True

End Sub

Answer 1

我刚刚添加了一个for循环，迭代1到2列更高的值，使你的逻辑失效。

Sub VDA_Update()

Dim wshT As Worksheet
    Dim wbk As Workbook
    Dim wshS As Worksheet
    Dim r As Long
    Dim m As Long
    Dim cel As Range
    Application.ScreenUpdating = False
    Set wshT = ThisWorkbook.Worksheets("Master")
    On Error Resume Next

    ' Check whether vda.xlsx is already open
    Set wbk = Workbooks("vda.xlsx")
    On Error GoTo 0
    If wbk Is Nothing Then
        ' If not, open it
        Set wbk = Workbooks.Open("C:\Working\vda_test.xlsx")
    End If

    ' Set worksheet on vda.xlsx
    Set wshS = wbk.Worksheets("imac01")
    m = wshT.Cells(wshT.Rows.Count, 1).End(xlUp).Row

    ' Loop though cells in column J on main.xlsm
    For r = 1 To m

        ' Can we find the value in column A of vda.xlsx?

        Set cel = wshS.Columns(1).Find(What:="TEST\" + wshT.Cells(r, 10).Value, _
        LookAt:=xlWhole, MatchCase:=False)

        for i = 1 to 2  'K and L columns, Column J=10
            If Cel is Nothing then
                Set cel = wshS.Columns(1).Find(What:="TEST\" + wshT.Cells(r, 10 + i).Value, _
                LookAt:=xlWhole, MatchCase:=False)
            else
                exit for
            end if
        next i

        If Not cel Is Nothing Then

            MsgBox wshS.Cells(r, 1)

            ' If we find a match, then change the text to red
            wshT.Cells(r, 10).Font.ColorIndex = 3

        End If
    Next r

    Application.ScreenUpdating = True

End Sub

在多列中搜索匹配项

1 个答案: