Question

我有三个比较两列的宏

我使用的那个在大文件上变化很慢但是有效

Sub MatchPermissionGiverAndTarget()
Dim LastRow As Long
Dim ws As Excel.Worksheet

GoFast False

Set ws = ActiveWorkbook.Sheets("Helper")
LastRow = ws.Range("A" & ws.Rows.count).End(xlUp).Row

Range("E1").EntireColumn.Insert
Range("E1").FormulaR1C1 = "name"

With ws.Range("E2:E" & LastRow)
    .Formula = "=INDEX(B:B,MATCH($D2,$B:$B,0))"
    .Value = .Value
End With

Columns("D:D").EntireColumn.Delete

GoFast True

End Sub

我在@mehow Here Fast compare method of 2 columns

找到了这个

但是我无法弄清楚如何应用它，所以它是第一剂量的剂量

对此有任何帮助表示赞赏

Sub Main()
Application.ScreenUpdating = False

Dim stNow As Date
stNow = Now

Dim arr As Variant
arr = Range("B2:A" & Range("B" & Rows.Count).End(xlUp).Row).Value


 Range("E1").EntireColumn.Insert
 Range("E1").FormulaR1C1 = "name"

Dim varr As Variant
varr = Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row).Value

Dim x, y, match As Boolean
For Each x In arr
    match = False
    For Each y In varr
        If x = y Then match = True
    Next y
    If Not match Then
        Range("D" & Range("D" & Rows.Count).End(xlUp).Row + 1) = x
    End If
Next

 Columns("D:D").EntireColumn.Delete

Debug.Print DateDiff("s", stNow, Now)
Application.ScreenUpdating = True
End Sub

或者来自@Reafidy的同一个帖子

Sub HTH()

Application.ScreenUpdating = False

With Range("E2", Cells(Rows.Count, "E").End(xlUp)).Offset(, 1)
    .Formula = "=VLOOKUP(B2,D:D,1,FALSE)"
    .Value = .Value
    .SpecialCells(xlCellTypeConstants, 16).Offset(, -1).Copy Range("D" & Rows.Count).End(xlUp).Offset(1)
    .ClearContents
End With

Application.ScreenUpdating = True

End Sub

Answer 1

试试这个：

Sub Main()
    Dim ws As Worksheet
    Dim stNow As Date
    Dim lastrow As Long, lastrowB As Long
    Dim match As Boolean
    Dim k As Long
    Dim arr, varr, v, a, res

    Application.ScreenUpdating = False

    stNow = Now

    Set ws = ActiveWorkbook.Sheets("Helper")

    With ws
        lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
        lastrowB = .Range("B" & .Rows.Count).End(xlUp).Row

        arr = .Range("B2:B" & lastrowB).Value
        varr = .Range("D2:D" & lastrow).Value

        .Range("E1").EntireColumn.Insert
        .Range("E1").FormulaR1C1 = "name"
    End With

    k = 1

    ReDim res(1 To lastrow, 1 To 1)

    For Each v In varr
        match = False
        'if value from column D (v) contains in column B
        For Each a In arr
            If a = v Then
                match = True
                Exit For
            End If
        Next a

        If match Then
            res(k, 1) = v
        Else
            res(k, 1) = CVErr(xlErrNA)
        End If
        k = k + 1
    Next v

    With ws
        .Range("E2:E" & lastrow).Value = res
        .Range("D:D").Delete
    End With


    Debug.Print DateDiff("s", stNow, Now)
    Application.ScreenUpdating = True
End Sub

如何应用“找到”宏

1 个答案: