Блог

Я новичок в VBA и пытаюсь найти дубликаты в столбце A и скопировать столбцы A, G и I на другой лист и использовать приведенный ниже код

 Dim wstSource As Worksheet, _
    wstOutput As Worksheet
Dim rngMyData As Range, _
    helperRng As Range, _
    unionRng As Range
Dim i As Long, iOld As Long

Set wstSource = Worksheets("Final Product List")
Set wstOutput = Worksheets("INN Working")

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With wstSource
    Set rngMyData = .Range("A2:A" amp; .Range("A" amp; .Rows.Count).End(xlUp).Row)
End With

With rngMyData
    Set helperRng = .Offset(, rngMyData.Columns.Count - 1).Resize(, 1)
    Set unionRng = .Cells(1000, 1000) 'set a "helper" cell to be used with Union method, to prevent it from failing the first time
End With

With helperRng
    .FormulaR1C1 = "=row()" 'mark rows with ad ascending number (its own row number)
    .Value = .Value
End With

With rngMyData.Resize(, rngMyData.Columns.Count   1) 'enclose "helper" column
    .Sort key1:=.Columns(1), Order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlNo ' sort data to have all same columnA values grouped one after another
    i = .Rows(1).Row 'start loop from data first row
    Do While i < .Rows(.Rows.Count).Row
        iOld = i 'set current row as starting row
        Do While .Cells(iOld   1, 1) = .Cells(iOld, 1) 'loop till first cell with different value
            iOld = iOld   1
        Loop

        If iOld - i > 0 Then Set unionRng = Union(unionRng, .Cells(i, 1).Resize(iOld - i   1)) 'if more than one cell found with "current" value, then add them to "UnionRng" range
        i = iOld   1
    Loop
    Intersect(unionRng, rngMyData).EntireRow.Copy Destination:=wstOutput.Cells(1, 1) 'get rid of the "helper" cell via Intersect method
    wstOutput.Columns(helperRng.Column).Clear 'delete "Helper" column pasted in wstOutput sheet
    .Sort key1:=.Columns(4), Order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlNo ' sort data in wstSource back
End With
helperRng.Clear 'delete "helper" column, not needed anymore

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
  

Приведенный выше код выдает ошибку времени выполнения ’91’
Переменная объекта или с неустановленной переменной блока

 If iOld - i > 0 Then Set unionRng = Union(unionRng, .Cells(i, 1).Resize(iOld - i   1)) 'if more than one cell found with "current" value, then add them to "UnionRng" range
    i = iOld   1
End If
  

Отсутствовал End If , и VBA выдает плохое сообщение.