我需要一個宏，將檢查新的項目，如果它已經存在或者是

Question

我有2個文件名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