Question

我正在尝试增强当前的脚本。 Sheet1和Sheet2仅包含A列中的文件路径名。如果在Sheet1中找不到Sheet2中的文件路径，则会将其复制到工作表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

在另一个工作表中查找多个单元格的范围

2 个答案: