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

End Sub

Answer 1

以下是我的逻辑：

循环播放第1页
对于工作表1列A中的每个单元格，转到工作表2并使用Range.Find在Sheet1列A中搜索值
If (cell Is Nothing) Then ' copy and paste Sheet1 current row to Sheet3
为Sheet3中的当前行保留一个计数器，并在每次将行粘贴到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

我写了一些东西来比较两个不同工作簿中的两个工作表，这是我的代码的修改版本：
它会将“导出”表单和“导入”表单之间的所有差异打印到“Err”表单上。您有“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

希望这对你的问题有用，如果不让我知道的话。

比较两张纸之间的列值

2 个答案: