Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Отбор повторяющихся значений
 
#1
29.03.2018 13:33:19
Добрый день, подскажите, как из исходной таблицы отобрать только те значения, которые имеют повторы?

И будет ли это применимо к таблице в 150 тысяч строк
Изменено: AnastasiaWrite - 29.03.2018 16:18:40
 
 
 
#2
29.03.2018 13:52:16
Код
Sub GetDup()
Dim arr(), arrNew(), I&, J&
arr = Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row).Value
ReDim arrNew(0 To UBound(arr) - 1, 0 To 0)
On Error Resume Next
With CreateObject("Scripting.Dictionary")
    For I = 1 To UBound(arr)
        .Add CStr(arr(I, 1)), arr(I, 1)
        If Err <> 0 And Not .Item(CStr(arr(I, 1))) Like "*^" Then
            arrNew(J, 0) = arr(I, 1)
            .Item(CStr(arr(I, 1))) = .Item(CStr(arr(I, 1))) & "^"
            J = J + 1
            Err.Clear
        End If
    Next
End With
Range("F2").Resize(J) = arrNew
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
29.03.2018 13:55:32
Так?
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#4
29.03.2018 14:27:07
Да, спасибо =)
Изменено: AnastasiaWrite - 29.03.2018 14:28:33
 
 
 
#5
29.03.2018 14:28:43
Цитата
AnastasiaWrite написала:
И будет ли это применимо к таблице в 150 тысяч столбцов
Гостья из будущего... :)  
Изменено: sokol92 - 29.03.2018 14:32:37
Владимир
 
 
 
#6
29.03.2018 20:30:38
еще вариант макроса,кнопки replica и очистка

 
Код
Sub replica()
Dim z, z1, i&, m&: z = Range("C1:C" & Range("C" & Rows.Count).End(xlUp).Row).Value
Application.ScreenUpdating = False
ReDim z1(1 To UBound(z), 1 To 1)
    With CreateObject("scripting.dictionary"): .CompareMode = 1
     For i = 1 To UBound(z): .Item(z(i, 1)) = .Item(z(i, 1)) + 1: Next
    For i = 1 To UBound(z)
     If .Item(z(i, 1)) > 1 Then: m = m + 1: z1(m, 1) = z(i, 1)
    Next
  unic z1
  sort
End With
Application.ScreenUpdating = True
End Sub
Изменено: кузя1972 - 29.03.2018 20:50:46
 
 
 
Страницы: 1
Наверх