Question

我试图添加一个vba代码，该代码在工作表YTDFigures的列中查找，并查看工作表EeeDetails中是否有重复内容。如果还没有，那么我想复制YTDFigures数据并粘贴到新工作表中。我尝试过的代码在run time error 91行上收到错误FinName = Worksheets("EeeDetails").Range("A:A").Find(What:=SearchName, LookIn:=xlValues)我认为这样做会好像匹配未发现.Find函数没有返回任何内容。< / p>

Sub CheckMatch()

Application.ScreenUpdating = False

    Dim SearchName As Range, SearchNames As Range
    Dim Usdrws As Long
    Dim row As Integer

    Usdrws = Worksheets("YTDFigures").Range("A" & Rows.Count).End(xlUp).row
    Set SearchNames = Worksheets("YTDFigures").Range("A2:A" & Usdrws)

        For Each SearchName In SearchNames
        row = Split(SearchName.Address, "$")(2)
        FinName = Worksheets("EeeDetails").Range("A:A").Find(What:=SearchName, LookIn:=xlValues)
            If FinName Is Nothing Then
                Range("A" & row & ":S" & row).Copy

                LastRow = Worksheets("Errors").Range("AA" & Rows.Count).End(xlUp).row + 1

                Worksheets("Errors").Activate
                Range("A" & LastRow).Select
                Selection.PasteSpecial
                Worksheets("EeeDetails").Activate
            End If
        Next

Application.ScreenUpdating = True

End Sub

Answer 1

您可以将原始数据放入数组中，将数组放在临时表上，删除重复数据，复制数据，然后删除临时表。

见下文：

Sub CheckMatch()

Application.ScreenUpdating = False

    Dim ws As Worksheet, tRows As Long
    Set ws = ThisWorkbook.Worksheets(1)
    Set RngA = ws.UsedRange.Columns("A")

    tRows = ws.Rows(ws.Rows.Count).End(xlUp).row
    Dim valA As Variant
    valA = ws.Range(ws.Cells(1, 1), ws.Cells(tRows, 1)).Value

    Dim tempWs As Worksheet
    Set tempWs = ThisWorkbook.Worksheets.Add
    tempWs.Name = "Temp1"

    With tempWs
        .Range(.Cells(1, 1), .Cells(tRows, 1)) = valA
        With .UsedRange.Columns("A")
            .RemoveDuplicates Columns:=1, Header:=xlYes
            .Copy
        End With
    End With

    ' Do what you need to do with your copied data

    Application.DisplayAlerts = False
    tempWs.Delete
    Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub

修改我刚用超过10k行的样本数据测试了它，它的工作时间不到半秒。它非常快。

如果没有找到，Vba会找到重复项并进行复制

1 个答案: