Question

我有两个名为NewEntries.CSV和Existing.CSV

的文件

Header A1(Company Code), B1(PurchaseOrg),C1(TransactionType),D1(CommodityCode),E1(MinTC),F1(MaxTC)

如何实施此条件以检查新条目并复制新文件或工作表中的相同或范围条目。

IF [NewEntries(A1,B1,C1,D1) = Existing(A1,B1,C1,D1:A*,B*,C*,D*)] & [NewEntries(E1)>= Existing(E*) OR NewEntries(F1)<= Existing(F*)]

Answer 1

首先检查你的逻辑。将下面的代码放在新工作簿中。（代码可能会缩短。要查看逻辑更好。）

Private Sub FindNews()
    Dim intRowE As Long
    Dim intRowN As Long
    Dim intRowD As Long

    Dim Existing As Workbook
    Dim NewEntries As Workbook

    Dim WorksheetExisting
    Dim WorksheetNewEntries

    Application.ScreenUpdating = false

    Set Existing = Workbooks.Open(Filename:=Application.ActiveWorkbook.Path & "\Existing.csv")
    Set NewEntries = Workbooks.Open(Filename:=Application.ActiveWorkbook.Path & "\NewEntries.csv")

    Set WorksheetExisting = Existing.Worksheets("Sheet1")
    Set WorksheetNewEntries = NewEntries.Worksheets("Sheet1")

    intRowD = 1

    For intRowN = 2 To WorksheetNewEntries.UsedRange.Rows.Count
        For intRowE = 2 To WorksheetExisting.UsedRange.Rows.Count
            If (WorksheetNewEntries.Cells(intRowN, 1).Value = WorksheetExisting.Cells(intRowE, 1).Value _
                    And WorksheetNewEntries.Cells(intRowN, 2).Value = WorksheetExisting.Cells(intRowE, 2).Value _
                    And WorksheetNewEntries.Cells(intRowN, 3).Value = WorksheetExisting.Cells(intRowE, 3).Value _
                    And WorksheetNewEntries.Cells(intRowN, 4).Value = WorksheetExisting.Cells(intRowE, 4).Value) _
                    And (WorksheetNewEntries.Cells(intRowN, 5).Value >= WorksheetExisting.Cells(intRowE, 5).Value _
                    Or WorksheetNewEntries.Cells(intRowN, 6).Value <= WorksheetExisting.Cells(intRowE, 6).Value) Then

                Range("A" & CStr(intRowD) & ":F" & CStr(intRowD)).Value = WorksheetExisting.Range("A" & CStr(intRowN) & ":F" & CStr(intRowN)).Value
                intRowD = intRowD + 1
                Exit For

             End If
        Next
    Next

    Application.ScreenUpdating = true

    Existing.Close SaveChanges:=False
    NewEntries.Close SaveChanges:=False
End Sub

Answer 2

@kitap mitap 我已经运行了这段代码，但在

中遇到了下标错误

ActiveWorkbook.Worksheets("sheet1").Cells(intRowD, 1).Value = WorksheetNewEntries.Cells(intRowN, 1).Value

以下是完整的代码：

Sub Button1_Click()
    '
    ' Button1_Click Macro
    '
    Dim intRowE As Long
    Dim intRowN As Long
    Dim intRowD As Long

    Dim Existing As Workbook
    Dim NewEntries As Workbook

    Dim WorksheetExisting As Worksheet
    Dim WorksheetNewEntries As Worksheet

    Dim wb As Workbook
    Dim strFile As String, strDir As String

    strDir = "C:\Users\john.michael.a.bunyi\Desktop\FR044 Testing\"
    strFile = Dir(strDir & "Acc_FR044_SAP.csv")

    Do While strFile <> ""
    Set wb = Workbooks.Open(Filename:=strDir & strFile, Local:=True)
    wb.SaveAs Replace(wb.FullName, ".csv", ".xls"), FileFormat:=xlExcel8
    wb.Close True

    Set wb = Nothing
    strFile = Dir
    Loop

    strDir = "C:\Users\john.michael.a.bunyi\Desktop\FR044 Testing\"
    strFile = Dir(strDir & "Acc_FR044_SAP - New Entries.csv")

    Do While strFile <> ""
    Set wb = Workbooks.Open(Filename:=strDir & strFile, Local:=True)
    wb.SaveAs Replace(wb.FullName, ".csv", ".xls"), FileFormat:=xlExcel8
    wb.Close True

    Set wb = Nothing
    strFile = Dir
    Loop

    Set Existing = Workbooks.Open(Filename:="C:\Users\john.michael.a.bunyi\Desktop\FR044 Testing\Acc_FR044_SAP.xls")
    Set NewEntries = Workbooks.Open(Filename:="C:\Users\john.michael.a.bunyi\Desktop\FR044 Testing\Acc_FR044_SAP - New Entries.xls")

    Set WorksheetExisting = Existing.Worksheets("Acc_FR044_SAP")
    Set WorksheetNewEntries = NewEntries.Worksheets("Acc_FR044_SAP - New Entries")

    intRowD = 1

    For intRowN = 2 To WorksheetNewEntries.UsedRange.Rows.Count
        For intRowE = 2 To WorksheetExisting.UsedRange.Rows.Count
            If (WorksheetNewEntries.Cells(intRowN, 1).Value = WorksheetExisting.Cells(intRowE, 1).Value _
                    And WorksheetNewEntries.Cells(intRowN, 2).Value = WorksheetExisting.Cells(intRowE, 2).Value _
                    And WorksheetNewEntries.Cells(intRowN, 3).Value = WorksheetExisting.Cells(intRowE, 3).Value _
                    And WorksheetNewEntries.Cells(intRowN, 4).Value = WorksheetExisting.Cells(intRowE, 4).Value) _
                    And (WorksheetNewEntries.Cells(intRowN, 5).Value >= WorksheetExisting.Cells(intRowE, 5).Value _
                    Or WorksheetNewEntries.Cells(intRowN, 6).Value <= WorksheetExisting.Cells(intRowE, 6).Value) Then

                ActiveWorkbook.Worksheets("sheet1").Cells(intRowD, 1).Value = WorksheetNewEntries.Cells(intRowN, 1).Value
                ActiveWorkbook.Worksheets("sheet1").Cells(intRowD, 2).Value = WorksheetNewEntries.Cells(intRowN, 2).Value
                ActiveWorkbook.Worksheets("sheet1").Cells(intRowD, 3).Value = WorksheetNewEntries.Cells(intRowN, 3).Value
                ActiveWorkbook.Worksheets("sheet1").Cells(intRowD, 4).Value = WorksheetNewEntries.Cells(intRowN, 4).Value
                ActiveWorkbook.Worksheets("sheet1").Cells(intRowD, 5).Value = WorksheetNewEntries.Cells(intRowN, 5).Value
                ActiveWorkbook.Worksheets("sheet1").Cells(intRowD, 6).Value = WorksheetNewEntries.Cells(intRowN, 6).Value
                intRowD = intRowD + 1

             End If
        Next
    Next

    Workbooks("Acc_FR044_SAP.xls").Close
    Workbooks("Acc_FR044_SAP - New Entries.xls").Close

End Sub

我需要一个宏来检查新条目，如果它已经存在或者在现有条目的范围内

2 个答案: