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

0

2 つの異なるワークブックの 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

問題が解決しない場合は、お知らせください。

于 2013-08-29T17:12:05.040 に答える