比較兩列之間的值

Question

我試圖編寫一個函數VBA Excel，它讀取例如A1並繼續讀取每一行，直到該列中的值結束，函數將採用該值並查找此值在sheet2列A:A如果確實找到了值，它將使用offset()函數轉到右邊的下一個單元格。一旦它確認這些值與Sheet1中的值匹配，它將進入下一行（A2）並繼續，否則如果有不匹配的值將複製整行並將其粘貼在Sheet3上，這將顯示在sheet2中找不到值。

這是我到目前爲止所嘗試的，但它只複製第一行不匹配，並停止。

Sub citi() 

Dim oFSO As Object 
Dim arrData() As String 
Dim taxid(1 To 65000) As String 
Dim amount(1 To 65000) As String 
Dim tref(1 To 65000) As String 
Dim bnam(1 To 65000) As String 
Dim bnknu(1 To 65000) As String 
Dim bnkagc(1 To 65000) As String 
Dim bbnkac(1 To 65000) As String 
Dim citb(1 To 65000) As String 
Dim i As Long, j As Long 

Set oFSO = CreateObject("Scripting.FileSystemObject") 
arrData = Split(oFSO.OpenTextFile("C:\Users\alvaradod\Desktop\citi macro\Import File.txt").ReadAll, vbCrLf) 
Sheets("Import").Range("A1").Value = "Tax ID" 
Sheets("Import").Range("B1").Value = "Amount" 
Sheets("Import").Range("C1").Value = "TReference" 
Sheets("Import").Range("D1").Value = "BeneficiaryName" 
Sheets("Import").Range("E1").Value = "BankNum" 
Sheets("Import").Range("F1").Value = "BankAgency" 
Sheets("Import").Range("G1").Value = "BeneficiaryBankAcc" 
Sheets("Import").Range("H1").Value = "CitiAcc" 
For i = LBound(arrData) To UBound(arrData) 
    If Len(arrData(i)) > 0 Then 
     j = j + 1 
     taxid(j) = Mid(arrData(i), 49, 15) 
     amount(j) = Mid(arrData(i), 92, 15) 
     tref(j) = Mid(arrData(i), 26, 15) 
     bnam(j) = Mid(arrData(i), 257, 34) 
     bnknu(j) = Mid(arrData(i), 452, 3) 
     bnkagc(j) = Mid(arrData(i), 455, 4) 
     bbnkac(j) = Mid(arrData(i), 463, 15) 
     citb(j) = Mid(arrData(i), 622, 10) 
    End If 
Next i 

If j > 0 Then 
    '' On Error Resume Next 
    Sheets("Import").Range("A2").Resize(j).Value = Application.Transpose(taxid) 
    Sheets("Import").Range("B2").Resize(j).Value = Application.Transpose(amount) 
    Sheets("Import").Range("C2").Resize(j).Value = Application.Transpose(tref) 
    Sheets("Import").Range("D2").Resize(j).Value = Application.Transpose(bnam) 
    Sheets("Import").Range("E2").Resize(j).Value = Application.Transpose(bnknu) 
    Sheets("Import").Range("F2").Resize(j).Value = Application.Transpose(bnkagc) 
    Sheets("Import").Range("G2").Resize(j).Value = Application.Transpose(bbnkac) 
    Sheets("Import").Range("H2").Resize(j).Value = Application.Transpose(citb) 
End If 
Set oFSO = Nothing 
Erase arrData() 
Erase taxid 
Erase amount 
Erase tref 
Erase bnam 
Erase bnknu 
Erase bnkagc 
Erase bbnkac 
Erase citb 
i = 0 
j = 0 
Set oFSO = CreateObject("Scripting.FileSystemObject") 
arrData = Split(oFSO.OpenTextFile("C:\Users\alvaradod\Desktop\citi macro\Export File.txt").ReadAll, vbCrLf) 
Sheets("Export").Range("A1").Value = "Tax ID" 
Sheets("Export").Range("B1").Value = "Amount" 
Sheets("Export").Range("C1").Value = "TReference" 
Sheets("Export").Range("D1").Value = "BeneficiaryName" 
Sheets("Export").Range("E1").Value = "BankNum" 
Sheets("Export").Range("F1").Value = "BankAgency" 
Sheets("Export").Range("G1").Value = "BeneficiaryBankAcc" 
Sheets("Export").Range("H1").Value = "CitiAcc" 
For i = LBound(arrData) To UBound(arrData) 
    If Len(arrData(i)) > 0 Then 
     j = j + 1 
     taxid(j) = Mid(arrData(i), 189, 15) 
     amount(j) = Mid(arrData(i), 56, 15) 
     tref(j) = Mid(arrData(i), 24, 15) 
     bnam(j) = Mid(arrData(i), 204, 34) 
     bnknu(j) = Mid(arrData(i), 296, 3) 
     bnkagc(j) = Mid(arrData(i), 299, 4) 
     bbnkac(j) = Mid(arrData(i), 345, 15) 
     citb(j) = Mid(arrData(i), 284, 10) 
    End If 
Next i 
If j > 0 Then 
    '' On Error Resume Next 
    Sheets("Export").Range("A2").Resize(j).Value = Application.Transpose(taxid) 
    Sheets("Export").Range("B2").Resize(j).Value = Application.Transpose(amount) 
    Sheets("Export").Range("C2").Resize(j).Value = Application.Transpose(tref) 
    Sheets("Export").Range("D2").Resize(j).Value = Application.Transpose(bnam) 
    Sheets("Export").Range("E2").Resize(j).Value = Application.Transpose(bnknu) 
    Sheets("Export").Range("F2").Resize(j).Value = Application.Transpose(bnkagc) 
    Sheets("Export").Range("G2").Resize(j).Value = Application.Transpose(bbnkac) 
    Sheets("Export").Range("H2").Resize(j).Value = Application.Transpose(citb) 
End If 

Set oFSO = Nothing 
Erase arrData 

''new code 

Dim r As Excel.Range 
Dim cell As Excel.Range 
Set r = Sheet2.Range(Sheet2.Cells(1, 1), Sheet2.Cells(Rows.Count, 1).End(xlUp)) 
Dim curRowSheet1 As Long 

curRowSheet1 = 1 

For Each cell In r 
    On Error Resume Next 
    Set rfind = Sheet3.Range("C:C").Find(cell.Value) 
    On Error GoTo 0 

    If (rfind Is Nothing) Then 
     cell.EntireRow.Copy Sheet1.Cells(curRowSheet1, 1) 
     curRowSheet1 = curRowSheet1 + 1 
    End If 
Next cell 

末次

Answer 1

這裏是我的邏輯怎麼會是這個：

1. 遍歷表1
2. 對於表1列A的每一個細胞，去表2和使用Range.Find以搜索Sheet1列中的值A
3. If (cell Is Nothing) Then ' copy and paste Sheet1 current row to Sheet3
4. Keep ac ounter當前行的工作表Sheet 3，並增加它的每粘貼一行到Sheet3的時間

這裏是一個非常簡單的例子：

Option Explicit 

Sub compare() 
    Dim r As Excel.Range 
    Dim cell As Excel.Range 
    Dim rFind As Excel.Range 
    Set r = Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(Rows.Count, 1).End(xlUp)) 
    Dim curRowSheet3 As Long 

    curRowSheet3 = 1 

    For Each cell In r 
     Set rFind = Sheet2.Range("A:A").Find(cell.Value) 

     If (rFind Is Nothing) Then 
      cell.EntireRow.Copy Sheet3.Cells(curRowSheet3, 1) 
      curRowSheet3 = curRowSheet3 + 1 
     End If 
    Next cell 
End Sub 

順便說一句，我應該指出，使用Range.Find是遠遠超過您自己循環使用Sheet2的速度。

而且，你不需要每次都重設rFind到Nothing在循環的結束，因爲如果沒有找到Range.Find將返回Nothing，否則，它會返回一個Range對象。

Answer 2

我寫的東西在兩個不同的工作簿來比較兩個工作表，這是我的代碼修改後的版本：
它將你的「出口」表和「導入」片之間的每一個差異打印到你的「錯誤」表。 您有「C2：C25」，因此我使用了25，但如果您需要更多或更少的列，請更改numColumns值。

Sub findDifferentCells() 

    Dim prevSheet As Worksheet 
    Dim currSheet As Worksheet 
    Dim writingSheet As Worksheet 
    Dim x As Integer 
    Dim y As Integer 
    Dim numColumns As Integer 
    Dim endOfCurr As Integer 

    Set prevSheet = ThisWorkbook.Sheets("Import") 
    Set currSheet = ThisWorkbook.Sheets("Export") 
    Set writingSheet = ThisWorkbook.Sheets("Err") 
    numColumns = 25 

    endOfCurr = currSheet.Cells(Rows.count, 1).End(xlUp).Offset(1).Row 

    'Compare values of both worksheets: 
    For x = 0 To endOfCurr 
     For y = 0 To numColumns 
      If prevSheet.Range("A1").Offset(x, y).Value <> currSheet.Range("A1").Offset(x, y).Value Then 
       writingSheet.Range("A1").Offset(x, y).Value = currSheet.Range("A1").Offset(x, y).Value 
      End If 
     Next y 
    Next x 

    'Clean-up: 
    Set currSheet = Nothing 
    Set writingSheet = Nothing 
    Set prevSheet = Nothing 

End Sub 

希望對您的問題起作用，如果不讓我知道。