0

我正在尝试编写一个函数，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

结束子

4

2 回答 2

1

以下是我的逻辑：

  1. 循环通过工作表 1
  2. 对于 Sheet 1 A 列中的每个单元格，转到 Sheet 2 并使用Range.Find搜索 Sheet1 A 列中的值
  3. If (cell Is Nothing) Then ' copy and paste Sheet1 current row to Sheet3
  4. 在 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

Sheet2顺便说一句，我应该提到，使用 Range.Find 比自己循环要快得多。

此外，您不需要在循环结束时每次都重置rFind为，因为如果没有找到任何内容，它将返回，否则，它将返回一个对象。NothingRange.FindNothingRange

于 2013-08-29T15:44:19.950 回答
0

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

希望这对您的问题有用，如果不告诉我。

于 2013-08-29T17:12:05.040 回答