添加的所有數據wthin範圍內，則檢查是否已經存在

Question

我使用的FileDialog選擇其他工作簿與此有關。我想一次選擇多個文件。

這是我如何做到這一點：

With fd 

    .Filters.Clear 
    .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsb; *.xltx; *.xltm; *.xlt; *.xml; *.xlam; *.xla; *.xlw", 1 
    .AllowMultiSelect = True 
    If .Show = -1 Then 

    For Each vrtSelectedItem In .SelectedItems 

      'Extract the Filename (without its file extension) to the File Path 
      nPath = Mid(vrtSelectedItem, InStrRev(vrtSelectedItem, "\") + 1) 
      'nPath is Filename with path 
      nFilename = Left(nPath, InStrRev(nPath, ".") - 1) 

      If IsWorkBookOpen(vrtSelectedItem) = True Then 
        MsgBox "File already open." 
      Else 

       Set wrkbk = Workbooks.Open("" & vrtSelectedItem) 
       Set wrkbk_destination = ThisWorkbook '<--- this where is will add the data from files selected with FD 
       Set wrkbk_source = Workbooks("" & nFilename) '<--- this the selected files 

     With wrkbk_destination.Sheets("Defect Log") 
     .Activate 

      ' I want to add the all values within range here but check if data already exist 
      ' For example selected files have data within range of D11 : I11 , D12 : I12 and D13 : I13 
      ' I want to add these but if data within D12 : I12 already exist It will skip adding data and continue with 
      ' D13 : I13 

        End With 

我只需要的是如何做到這一點，我會成爲一個指向哪裏這個添加的數據將在wrkbk_destination顯示的例子。

Answer 1

幾個百分點

1. 您可以用對象wrkbk或wrkbk_source
2. 你並不需要檢查，如果數據已經存在的一個做掉的。只需複製數據即可，因爲只有小範圍D11:I13需要複製。最終使用.RemoveDuplicates。它會更快。
3. 您不需要繼續激活工作簿/工作表。您可以直接執行操作。您可能希望看到How to avoid using Select in Excel VBA macros

這是你想什麼（未測試）

Sub Sample() 
    ' 
    '~~> Rest of the code 
    ' 

    Dim lRow As Long 

    Set wrkbk_destination = ThisWorkbook 

    With fd 
     .Filters.Clear 
     .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsb; *.xltx;" & _ 
     "*.xltm; *.xlt; *.xml; *.xlam; *.xla; *.xlw", 1 

     .AllowMultiSelect = True 

     If .Show = -1 Then 

     For Each vrtSelectedItem In .SelectedItems 
      If IsWorkBookOpen(vrtSelectedItem) = True Then 
       MsgBox "File already open." 
      Else 
       Set wrkbk_source = Workbooks.Open(vrtSelectedItem) 

       With wrkbk_destination.Sheets("Defect Log") 
        lRow = .Range("D" & .Rows.Count).End(xlUp).Row + 1 

        .Range("D" & lRow & ":I" & (lRow + 2)).Value = _ 
        wrkbk_source.Sheets(1).Range("D11:I13").Value 
       End With 

       wrkbk_source.Close (False) 
      End If 
     Next vrtSelectedItem 
    End With 

    With wrkbk_destination.Sheets("Defect Log") 
     lRow = .Range("D" & .Rows.Count).End(xlUp).Row 

     '~~> Change xlNo to xlYes if the column has headers 
     .Columns("D1:I" & lRow).RemoveDuplicates Columns:= _ 
     Array(1, 2, 3, 4, 5, 6), Header:=xlNo 
    End With 
End Sub