Найти диапазон нескольких ячеек в другом листе

Question

Я пытаюсь улучшить свой текущий скрипт. Лист1 и Лист2 содержат только имена Filepath в столбце A. Если путь_к_файл в Лист2 не найден в Лист1, он копируется в лист 3.

'row counter 
x = 1 
'Initiate Variables 
Set wb = ActiveWorkbook 
Set ws1 = wb.Sheets("Sheet1") 
Set ws2 = wb.Sheets("Sheet2") 

'create a new sheet 3, delete old one if it exists 
If Sheets.Count > 2 Then 
Application.DisplayAlerts = False 
    Sheets(3).Delete 
Application.DisplayAlerts = False 
End If 

Sheets.Add After:=Sheets(Sheets.Count) 
Sheets(Sheets.Count).Name = "Sheet3" 

Set ws3 = wb.Sheets("Sheet3") 

'Get row count to know how many times to loop 
rowCount2 = ws2.Range("A1").End(xlDown).Row 

'compare filepaths from sheet2 to sheet1 
'if there is a difference, that difference is put on sheet 3 
For i = 1 To rowCount2 
    FilePath = ws2.Cells(i, 1) 
    With Sheets("Sheet1").Range("A:A") 
     Set CellId = .Find(What:=FilePath, _ 
         After:=.Cells(.Cells.Count), _ 
         LookIn:=xlValues, _ 
         LookAt:=xlWhole, _ 
         SearchOrder:=xlByRows, _ 
         SearchDirection:=xlNext, _ 
         MatchCase:=False) 
     If Not CellId Is Nothing Then 
     'do nothing if filepath is found in both sheets 
     Else 
      'put the filepath from file2 not found in file1, into 
      'sheet 3 
      ws3.Cells(x, 1) = FilePath 
      x = x + 1 
     End If 
    End With 
Next I 

То, что я хочу сделать, это быть в состоянии к опорному диапазон ячеек для сравнения, а не только из столбца A. Вместо просто путей к файлам в столбце A они будут сохранены последним в столбце B, последним открываются в столбце C и т. д. Поэтому вместо того, чтобы просто проверять разницу в пути к файлу, Я хочу разницу в нескольких столбцах. Таким образом, могут быть одни и те же файловые пути, но он был открыт кем-то другим в другой день. Мне нужно понять эту разницу. Я не знаю, как обращаться с диапазоном нескольких ячеек. Поэтому мне нужно, чтобы исправить этот раздел кода:

FilePath = ws2.Cells(i, 1) 
With Sheets("Sheet1").Range("A:A") 

И если есть более простой способ приблизиться к этому я открыт для советов.

Answer 1

В разделе 'do nothing if filepath is found in both sheets поместите что-то вроде этого:

k = ws2.Cells(1,ws2.Columns.Count).End(xlToleft).Column 
For j = 2 to k 
    If ws2.Cells(i, j).Value <> CellId.Offset(, j - 1).Value Then 
     CellId.EntireRow.Copy ws.Cells(x,1).EntireRow 
     x = x +1 
     Exit For 
     'or whatever code you need to move to sheet3 
    End If 
Next 

Answer 2

Я использую словарь при сравнении множественного списка. Таким образом, я только один раз перебираю каждый список.

Sub CopyMissingFileNames() 
    Dim filepath As Range, Target As Range 
    Dim dictFilePaths As Object 
    Set dictFilePaths = CreateObject("Scripting.Dictionary") 

    With Worksheets("Sheet1") 

     For Each filepath In .Range("A2", .Range("A" & Rows.Count).End(xlUp)) 

      If Not dictFilePaths.Exists(filepath.Text) Then dictFilePaths.Add filepath.Text, "" 
     Next 

    End With 


    With Worksheets("Sheet2") 

     For Each filepath In .Range("A2", .Range("A" & Rows.Count).End(xlUp)) 
      If Not dictFilePaths.Exists(filepath.Text) Then 
       Set Target = Worksheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1) 

       filepath.EntireRow.Copy Target 
      End If 
     Next 

    End With 



End Sub