Страницы: 1
RSS
Удаление повторяющихся значений без смещения ячеек с дополнительным условием
 
Доброго времени.
Есть задача, с которой не могу справиться. Два столбца. В первом указан номер заказ, во втором id оператора, который добавил товар в корзину заказа.
Необходимо удалить повторяющиеся номера заказов с сохранением их позиций. Есть одно условие, если в корзину товары добавляли разные операторы, то слева оставить номер заказа.
С удаление повторов , чтобы сохранить позиции я справлялся с этим макросом. А вот со вторым условием никак не разберусь. Пример во вложении.
Код
Sub DelDup()
Dim arr(), I&
With Worksheets("Лист1")
    arr = .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
End With
On Error Resume Next
With CreateObject("Scripting.Dictionary")
    For I = 1 To UBound(arr)
        .Add CStr(arr(I, 1)), I
        If Err <> 0 Then
            arr(I, 1) = Empty
            Err.Clear
        End If
    Next
End With
Worksheets("Лист1").Range("A1").Resize(UBound(arr), 1) = arr
End Sub
 
Так? Немного не бьется с вводными данными. Или там ошибка или мало вводных
 
Так нужно?
Код
Sub main()
    Dim dic As Object
    Dim i&, txt$, lrow&
    
    Set dic = CreateObject("scripting.dictionary")
    lrow = Range("f" & Rows.Count).End(xlUp).Row
    For i = 3 To lrow
        txt = Range("f" & i).Value & Range("g" & i).Value
        If Not dic.exists(txt) Then
            dic.Item(txt) = txt
        Else: Range("f" & i).ClearContents
        End If
    Next i
End Sub
"Все гениальное просто, а все простое гениально!!!"
 
kain, Nordheim, Оба варианта рабочие, спасибо !
Страницы: 1
Наверх