Страницы: 1
RSS
Список дублей из столбца (или диапазона)
 
Добрый день! Мне необходимо функцией vba извлечь дубликаты из списка(столбца). (можно и макросом (Sub), но я не знаю, как универсально указать место(ячейку) для вывода результата... (адрес ячейки для вывода результата всегда разный), поэтому хочу использовать Function. Я написал вот такую программку

Код
Function Список_Дублей_1(Rng1 As Range) As Variant
Dim i As Long, j As Long
Dim a As Variant    
Dim k, x, n, ind As Long    
Dim Arr(1 To 50) As String j = 1       
     For i = 1 To Rng1.Rows.Count           
     k = Application.WorksheetFunction.CountIf(Rng1, Rng1.Cells(i, 1))           
         If k > 1 Then           
         Arr(j) = Rng1.Cells(i, 1)           
         j = j + 1           
         End If       
Next i        
Список_Дублей_1 = Application.WorksheetFunction.Transpose(Arr())
End Function
Но моя функция выдает список дублей с оригиналом. В приложенном файле я хотел бы получить результат в виде списка
Код
7434175
7448800
7448800 
а не
Код
7434175
7434175
7448800
7448800
7448800
Я понимаю, что вместо  
Цитата
k = Application.WorksheetFunction.CountIf(Rng1, Rng1.Cells(i, 1))

надо написать аналог счётесли(A$1$:А1;А1) > 1 то..... что-то типа

k = Application.WorksheetFunction.CountIf((Rng1.Cells(1,1):Rng1.Cells(i,1)), Rng1.Cells(i, 1))  (хочу просматривать универсальный диапазон, который всегда в разных местах. или еще мой предполагаемый вариант который не работает)

k = Application.WorksheetFunction.CountIf((Rng1.Cells(i,1).End(xlUp),Rng1.Cells(i, 1)

Помогите, пожалуйста, написать правильно и универсально! p.s. коллекции и мн. др. я пока не понимаю, хотелось бы увидеть решение на понятном мне уровне))

И еще, подскажите, почему, если я хочу сделать
redim Arr(1 to Rng1.Rows.Count),.. да даже redim Arr(1 to 100), то программа на меня ругается, выделяя желтым цветом первую строчку

Код
Function Список_Дублей_1(Rng1 As Range) As Variant
 
Цитата
Список дублей из столбца
А расширенный фильтр вам не подойдет?
 
Вроде как написано так и работает.
И     ReDim Arr(1 To Rng1.Rows.Count) As String работает.
А чтоб не выдавало повторы - нужно запоминать и проверять, что такое значение уже было.
Вообще проще всего на словаре делать - если повтор второй, то выводим, другие игнорируем.
Код
Function Список_Дублей_1(Rng1 As Range) As Variant
    Dim j As Long
    ReDim Arr(1 To Rng1.Rows.Count) As String

    With CreateObject("Scripting.Dictionary"): .comparemode = 1
        For Each c In Rng1
            .Item(c.Value) = .Item(c.Value) + 1
            If .Item(c.Value) = 2 Then j = j + 1: Arr(j) = c.Value
        Next
    End With
    
    Список_Дублей_1 = Application.WorksheetFunction.Transpose(Arr())
End Function

Изменено: Hugo - 20.04.2015 16:53:44
 
Kuzmich,
Цитата
А расширенный фильтр вам не подойдет?
Мне нужны не уникальные значения а именно дубликаты.
Hugo, спасибо за код! мой код работает, но выдает лишние знасения, вместо
Цитата
7434175
7448800
7448800
выдает
Цитата
7434175
7434175
7448800
7448800
7448800
а Ваш код дал результат
Цитата
7434175
7448800
что,конечно, полезно, но я не могу отследить количество каждого инвентарного номера, сколько лишних раз он повторяется.
Простите, наверно я не четко обозначил цель. Задача состоит в том, чтобы получить список инвентарных номеров, которые в столбце встречаются более 1 раза, и,если инвентарный номер в столбце повторяется, к примеру 3 раза, то я хочу в результате видеть столбец, в котором этот инвентарный номер прописан два раза))
 
Ну так а подумать?
Код
If .Item(c.Value) > 1 Then j = j + 1: Arr(j) = c.Value
 
Шикарно))))) то что нужно!!!! Спасибо огромное!!!
Цитата
Ну так а подумать?

Я данную часть не понимал (поэтому не мог подумать)
Код
.Item(c.Value) = .Item(c.Value) + 1            
If .Item(c.Value) = 2 Then...
А сейчас уже плохо понимаю, к ночи, глядишь, уже буду почти нормально понимать)))
Спасибо!!
 
Каждое заносим в словарь как ключ, каждому в item считаем количество занесений. В начале отбирал только второе, теперь все больше первого.
 
Hugo, спасибо!!!
Страницы: 1
Наверх