Question

我决定将这些代码发布在这个代码上，我已经在这里抨击了几天而且它已经杀了我。我有两个非常大的列，我从其他列聚合以创建唯一的单元格值。我现在需要将这些唯一单元格值的一列与另一列唯一单元格值进行比较，以便查找重复项并在偏移列中打印这些重复的单元格值。这个例子中的代码与我的范围存在问题，我已经尝试过，对于每个，vlookup和索引匹配，我似乎无法做到正确。列大小每周都会更改，因此我无法对范围进行硬编码。

请帮助，谢谢。

这被标记为重复的问题，但我没有在表格中移动数据，左边只有8列。

Sub DEV_CODE_DuplicateCheck()
    'VBA Speed up settings
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False



        Dim sht1 As Worksheet
        Dim sht2 As Worksheet
        Set sht1 = Sheets("Sheet1")
        Set sht2 = Sheets("Sheet2")
        Dim n As Long
        pluginOne = 2
        ipOne = 6
        portOne = 8
        uniqueIdOne = 46

        Dim WorkFile As String
        VRMFile = ActiveWorkbook.Name

        'Unfilter original report to show all rows
        Workbooks(WorkFile).Worksheets("Sheet1").AutoFilterMode = False
        Workbooks(WorkFile).Worksheets("Sheet2").AutoFilterMode = False
    Application.Goto Reference:=Worksheets("Sheet1").Range("A1")


    Dim noSep As String
    noSep = ""

    Cells(1, 2) = pluginOne
    Cells(1, 6) = ipOne
    Cells(1, 8) = portOne
    Cells(1, 46) = uniqueIdOne

    x = 2
    Do While Cells(x, pluginOne) <> ""
    Cells(x, uniqueIdOne) = Cells(x, pluginOne) & noSep & Cells(x, ipOne) & noSep & Cells(x, portOne)
    x = x + 1
    Loop
    Columns("AT:AT").EntireColumn.AutoFit


    Worksheets("Sheet2").Activate


    pluginTwo = 3
    ipTwo = 30
    portTwo = 32
    uniqueIdTwo = 47

    Cells(2, 3) = pluginTwo
    Cells(2, 30) = ocisobIP
    Cells(2, 32) = portTwo
    Cells(1, 47) = uniqueIdTwo

    y = 2

    Do While Cells(y, pluginTwo) <> ""
    Worksheets("Sheet1").Cells(y, uniqueIdTwo) = Worksheets("sheet2").Cells(y, pluginTwo) & noSep & Worksheets("sheet2").Cells(y, ipTwo) & noSep & Worksheets("sheet2").Cells(y, portTwo)
    y = y + 1
    Loop
    Columns("AU:AU").EntireColumn.AutoFit

    Worksheets("Sheet1").Activate

    Range("au1").Select
        Selection.Delete shift:=xlUp

     ****EVERYTHING WORKS FINE TO THIS POINT*****

    Dim StartRange As Variant, j As Variant
    Dim CompareRange As Variant, i As Variant

    Set StartRange = Range("AT")
    Set CompareRange = Range("AU")

    For Each i In Selection
        For Each j In CompareRange
            If i = j Then i.Offset(0, -8) = i
        Next j
    Next i



    End Sub

比较数据未填充偏移列* VBA *

0 个答案: