使用带通配符的InStr函数比对单元格内容问题及代码检查

我尝试使用VBA的InStr函数，比对Sheet1.Cells(i,4)与Sheet2.Cells(i,3)的内容，将匹配结果写入Sheet2.Cells(i,10)，但得到的结果不符合预期。

初始代码 #

Sub CompareSheetsInstr2()
    Dim Sheet1 As Worksheet
    Dim Sheet2 As Worksheet
    Dim i As Long
    Dim j As Long
    
    '*********** ASSIGN INDEX NUMBER **************  
    
    ' Set the worksheet objects for both sheets
    Set Sheet1 = Worksheets("Sheet1")
    Set Sheet2 = Worksheets("Sheet2")     
    
    For i = 2 To Sheet2.UsedRange.Rows.Count            
          
        If InStr(1, LCase(Sheet1.Cells(i, 4).Value), LCase("*" & Sheet2.Cells(i, 3).Value & "*")) > 0 Or _
          InStr(LCase(Sheet2.Cells(i, 3).Value), LCase(Sheet1.Cells(i, 4).Value)) > 0 Then          
          
    '*********** MATCH BY INDEX NUMBER **************
                'If Sheet1.Cells(j, 3) = Sheet2.Cells(i, 4) Then           
                
                ' If there is a match, replace the value in Sheet2 with the value in Sheet1
                Sheet2.Cells(i, 10).Value = Sheet1.Cells(i, 1).Value                
                
            End If
        
        Next i
    ' Next j
    MsgBox "Comparison complete!"
End Sub

之后我修改了代码，目前该代码似乎运行正常，烦请帮忙检查是否存在问题。

修改后的代码 #

Sub CompareSheetsInstrModified()
Dim oSheet1 As Worksheet
Dim oSheet2 As Worksheet
Dim oSheet3 As Worksheet
Dim headers() As Variant
Dim a As Long, i As Long, j As Long, RowCnt As Long, RowCnt2 As Long
Dim arr1, arr2, res(), res1()
Dim arr3, arr4, res2(), res4()
Dim sKey1 As String, sKey2 As String
Dim sKey3 As Variant, sKey4 As String
headers() = Array("DATE", "NUMBER", "PAYEE", "ACCOUNT", "AMOUNT", "MEMO")
' Set the worksheet objects for both sheets
Set oSheet1 = Worksheets("Sheet1")
Set oSheet2 = Worksheets("Sheet2")
Set oSheet3 = Worksheets("Sheet2")
' Load data into array
arr1 = oSheet1.Range("A1").CurrentRegion.Value
arr2 = oSheet2.Range("A1").CurrentRegion.Value
arr3 = oSheet3.Range("A1").CurrentRegion.Value

' Store matching result in an array
RowCnt = UBound(arr2)
RowCnt2 = UBound(arr3)
ReDim res(1 To RowCnt, 1 To 1)
ReDim res1(1 To RowCnt, 1 To 1)
ReDim res2(1 To RowCnt2, 1 To 1)
ReDim res3(1 To RowCnt2, 1 To 8)
ReDim res4(1 To RowCnt2, 1 To 8)
' Loop through all rows in Sheet2

For i = LBound(arr2) + 1 To UBound(arr2)
'For i = LBound(arr3) + 1 To UBound(arr3)
    sKey2 = LCase(Trim(arr2(i, 3)))
    sKey3 = (arr2(i, 2))
    If Len(sKey2) > 0 Then
        ' Comparing all rows in Sheet1
        For j = LBound(arr1) To UBound(arr1)
            sKey1 = LCase(Trim(arr1(j, 4)))
            If Len(sKey1) > 0 Then
                ' Matching
                If InStr(sKey1, sKey2) + InStr(sKey2, sKey1) > 0 Then
                    ' Update the output
                    res(i, 1) = arr1(j, 1)
                    res1(i, 1) = arr1(j, 2)
                    res2(i, 1) = arr2(i, 2)
                    arr3(i, 1) = Abs(arr3(i, 5))
                    res3(i, 1) = arr3(i, 5)
                    res4(i, 1) = arr3(i, 8)
                    Exit For
                End If
            End If
        Next j
    End If
    ' Debug.Print "=match result=", i, j
Next i
' Drop data to column J (modify as needed)
oSheet2.Cells(1, 12).Resize(RowCnt, 1).Value = res
oSheet2.Cells(1, 13).Resize(RowCnt, 1).Value = res1
oSheet2.Cells(1, 10).Resize(RowCnt, 1).Value = res2
oSheet2.Cells(1, 14).Resize(RowCnt, 1).Value = res3
oSheet2.Cells(1, 11).Resize(RowCnt, 1).Value = res4
' Add Header
For a = LBound(headers) To UBound(headers)
    Sheet2.Cells(1, 10 + a).Value = headers(a)
    Next a
'Exit For
'MsgBox "Comparison complete!"
End Sub

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