使用“查找”比较两个不同工作表中的两列[关闭]

Question

如果工作表 1 的列值与工作表 2 的列值匹配，则在工作表 1 对应的第二个 (B) 列中写入匹配的值，否则写入不匹配的值

这是我运行时的示例代码 代码仅执行 if 条件，不执行 else 块以进行不匹配比较 - 它仅打印匹配

谁能帮忙看看如何更正代码

'FilePath = "C:\Users\Downloads\CompareExcel\Table1.xlsx"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.DisplayAlerts = False
Set objworkbook1 = objExcel.Workbooks.Open("C:\Users\Documents\GUI Scipts\Compare1.xlsx")
Set objworkbook2 = objExcel.Workbooks.Open("C:\Users\Documents\GUI Scipts\Compare2.xlsx")
Set objWorkSheet1 = objworkbook1.worksheets(1)
Set objWorkSheet2 = objworkbook2.worksheets(1)

' Dim I, total
' Dim fRow
'Dim found as Range
Dim fill, i
'Dim found As Range

total = objWorkSheet1.UsedRange.Rows.Count
total1 = objWorkSheet2.UsedRange.Rows.Count
'total = objWorkSheet1.UsedRange.Rows.Count
 
 For I = 1 To total
    answer1 = objWorkSheet1.Range("A" & I).Value
      set found = objWorkSheet2.Columns("A:A").Find(what=answer1) 'finds a match
      'MsgBox found
If found Is Nothing  Then  
    objWorkSheet1.Range("B" & I).Value = "MATCH"
      'MsgBox "match"

Else
      MsgBox "Not match"
      objWorkSheet1.Range("B" & I).Value = " Not MATCH"
    'fRow = objWorkSheet2.Columns("K:K").Find(what:=answer1).Row
      'MsgBox "Not Found"
End If
Next
MsgBox "Loop Ented"
objworkbook1.save 'Wsorkbook Save
objworkbook2.save' Workbook Save
objworkbook1.close'Workbook close
objworkbook2.close'Workbook close
objExcel.Quit

Answer 1

匹配单列中的数据

• 使用

  Match

  代替

  Find

  更直接、更高效。

Option Explicit

' Define constants.

Const FOLDER_PATH = "C:\Users\Documents\GUI Scipts\"
Const SRC_NAME = "Compare2.xlsx"
Const SRC_SHEET_ID = 1
Const SRC_LOOKUP_COLUMN = 1

Const DST_NAME = "Compare1.xlsx"
Const DST_SHEET_ID = 1
Const DST_LOOKUP_COLUMN = 1
Const DST_RETURN_COLUMN = 2

Const RESULT_YES = "Match"
Const RESULT_NO = "No match"

Dim xlApp: Set xlApp = CreateObject("Excel.Application")
'xlApp.Visible = True ' un-comment while testing

' Source

Dim swb: Set swb = xlApp.Workbooks.Open(FOLDER_PATH & SRC_NAME)
Dim sws: Set sws = swb.Worksheets(1)
Dim slrg, srCount
With sws.UsedRange
    srCount = .Rows.Count - 1 ' exclude header
    Set slrg = .Resize(srCount).Offset(1).Columns(SRC_LOOKUP_COLUMN)
End With

' Destination

Dim dwb: Set dwb = xlApp.Workbooks.Open(FOLDER_PATH & DST_NAME)
Dim dws: Set dws = dwb.Worksheets(1)
Dim dlrg, drCount
With dws.UsedRange
    drCount = .Rows.Count - 1 ' exclude header
    Set dlrg = .Resize(drCount).Offset(1).Columns(DST_LOOKUP_COLUMN)
End With

' Get the matching source row indexes.
Dim Data: Data = xlApp.Match(dlrg, slrg, 0)

swb.Close False ' don't save since it was just read from

' If there was a match, it is a number. If not, it is an error value.
' Replace numbers with yes-results and errors with no-results.

If drCount = 1 Then ' single row; the result is a (single) value
    If IsNumeric(Data) Then 
        Data = RESULT_YES
    Else
        Data = RESULT_NO
    End If
Else ' multiple rows; the result is a 2D one-based single-column array
    Dim dr
    For dr = 1 To drCount
        If IsNumeric(Data(dr, 1)) Then 
            Data(dr, 1) = RESULT_YES
        Else
            Data(dr, 1) = RESULT_NO
        End If
    Next
End If    

' Write the matching data to the destination (single-column) range.
Dim drrg: Set drrg = dlrg.EntireRow.Columns(DST_RETURN_COLUMN)
drrg.Value = Data
 
dwb.Close True ' save it since it was written to
 
xlApp.Quit

MsgBox "Data looked up.", vbInformation