Страницы: Пред. 1 2
RSS
Поиск повторяющихся значений и перенос их на другой лист (VBA)
 
OFF
Nordheim, здравствуйте! Начал ускорять свой код, добавил словарь, пишу, значится, а потом смотрю, что у меня примерно ваш код получается, только гораздо примитивнее  :D
Расскажите, пожалуйста — этой строкой dic.Item(txt) = dic.Item(txt) + 1 мы заносим ключ в словарь и сразу считаем одинаковые?  8-0  Не до конца понимаю, как работает это колдунство…

Матчасть всё та-же  и в ней сказано, что при добавлении дубля ключа этим способом произойдёт замена. Получается, что мы считаем замены?:)
Изменено: Jack Famous - 17.08.2018 13:45:11
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Nordheim, в строке 36  "End With" не лишнее?
Excel непознаваем как атом.
 
Цитата
в строке 36  "End With" не лишнее?
Лишнее, это осталось от предыдущего сообщения, которое автор исправил
 
Цитата
Kuzmich написал:
Лишнее, это осталось от предыдущего сообщения, которое автор исправил
Сначала сделал всю таблице форматом "@", затем изменил в коде диапазон а кусок убрать забыл  8-0
Изменено: Nordheim - 17.08.2018 13:45:57
"Все гениальное просто, а все простое гениально!!!"
 
Цитата
Jack Famous написал:
Матчасть  всё та-же  и в ней сказано, что при добавлении дубля ключа этим способом произойдёт замена. Получается, что мы считаем замены?
Совершенно верно, это своеобразный счетчик замен (в нашем случае совпадений).
"Все гениальное просто, а все простое гениально!!!"
 
OFF
Nordheim, фигасе  8-0 опять приятно удивили  :D спасибо вам большое!
Как допишу код - гляньте, пожалуйста, на предмет критики, если получится :) там будет кое-что моё)))
Изменено: Jack Famous - 17.08.2018 13:50:46
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
гляньте, пожалуйста, на предмет критики
Я не профессиональный программист, что бы критиковать, причем в работе даже Excel не использую, это так для саморазвития  :D. Как-то так.
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, помню, что вы говорили об xl в качестве хобби)) многое от вас узнаю - поэтому и попросил)) спасибо за науку)

Итак - вот код, почти точная копия кода от Nordheim. Перепробовал различные варианты и немного (на пару %) получилось ускорить. Оказывается, код от кузя1972 также очень похож, но у него отсутствует удаление дублей из источника и за счёт этого минус 2 цикла и выигрыш в 5 раз (30 сек против 150 на 150к строках реальных данных, как в файле). Пыхтел-пытался я сократить количество циклов, но не вышло.

Выводы: рост времени выполнения в геометрической прогрессии (10х) при увеличении количества строк (почти не зависит от количества столбцов) в арифметической. 1,4/13/150сек. для 50/100/150 тысяч строк. Около 80% времени (128 сек на 150к) занимает основной цикл по перезаполнению массива дублями и формированию диапазона для удаления. Для сравнения - на 50к строках этот цикл занимает всего лишь около 20% времени (0,16 сек). Удаление дублей из источника занимает в 2 раза меньшее время - 13 сек на 150к. Все остальные процессы занимают около 5с на 150к.

Ну вот как-то так
КОД
файл с макросом
Изменено: Jack Famous - 20.08.2018 11:20:00
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Здравствуйте, коллеги! Если применить "классический" метод удаления строк от Владимира (ZVI), то время выполнения будет O(N*Ln(N)). Думаю, что 15 сек (вместо 150) для 150к строк из примера #38 хватит с запасом.
Владимир
 
sokol92, приветствую вас!
А можно поподробнее о методе?))) фильтр по признаку в столбце, определяемому формулой?
Изменено: Jack Famous - 17.08.2018 20:28:41
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Если признак в столбце определять формулой, то будет долго (так как столбец Id не отсортирован). А вот если через словари (аналогично #38 и др. сообщениям), то быстро. Естественно, лучше признак вычислить в начале в массиве, а затем перенести из массива в дополнительный столбец.
Владимир
 
sokol92, кодом прокомментируете?  :D я только учусь))
в первом цикле дополнительно массив наполнять?
Изменено: Jack Famous - 17.08.2018 21:15:37
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Добрался до Excel. Иллюстрация к #39 (тщательно не тестировал).


Код
Option Explicit

Sub CutDupl()
  Dim rng As Range, dic As Object, sh2 As Worksheet
  Dim j1 As Long, j2 As Long, arr1, arr2
  Dim n As Long, nrows As Long, i As Long, key, old_calc
  Const duplName = "Duplicates"
  Set rng = Range("A1").CurrentRegion
  j1 = 7 ' номер столбца с ключом
  
  nrows = rng.Rows.Count - 1 ' число строк без заголовка
  If nrows <= 2 Then
    MsgBox "Число строк диапазона не превышает 2"
    Exit Sub
  End If
  j2 = rng.Columns.Count + 1  ' номер добавленного столбца в rng
  Set rng = rng.Offset(1).Resize(nrows, j2)
    ' без строки заголовка, с добавленным столбцом
  Set dic = CreateObject("Scripting.Dictionary")
  n = 0 ' счетчик дубликатов
  
  arr1 = rng.Columns(j1).Value
  ReDim arr2(1 To nrows, 1 To 1)  ' значения для добавленного столбца
  For i = 1 To nrows
    key = arr1(i, 1)              ' ключ
    If Not dic.exists(key) Then   ' ключ встретился впервые
      dic(key) = i                ' запомнили индекс массива
      arr2(i, 1) = 0
    Else
      arr2(i, 1) = 1: n = n + 1   ' дубль
      If dic(key) > 0 Then        ' заносим признак дубля в первую строку с ключом key
        arr2(dic(key), 1) = 1: n = n + 1
        dic(key) = 0
      End If
    End If
  Next i
  
  If n = 0 Then
    MsgBox "Повторов ключей не найдено"
    Exit Sub
  End If
  Set dic = Nothing ' словарь больше не нужен
  
  ' Начало корректировки информации книги
  With Application
    old_calc = .Calculation: .Calculation = xlCalculationManual: .ScreenUpdating = False
    
    With rng
      .Columns(j2).Value = arr2
      .Sort .Columns(j2), xlAscending, Header:=xlNo
      .Columns(j2).ClearContents
    End With
    
    ' последние n строк диапазона rng - дубли
    Set rng = rng.Offset(nrows - n).Resize(n)
    On Error Resume Next
    Set sh2 = Worksheets(duplName)
    On Error GoTo 0
    If sh2 Is Nothing Then
      Set sh2 = Worksheets.Add(After:=Worksheets(Worksheets.Count))
      sh2.Name = duplName
    Else
      sh2.Cells.Delete
    End If
    rng.Parent.Activate
    
    With rng.EntireRow
      .Copy sh2.Cells(1, 1)
      .Delete
    End With
   
    .Calculation = old_calc
    .ScreenUpdating = True
  End With

End Sub
Изменено: sokol92 - 18.08.2018 13:01:07
Владимир
 
Убрал цикл с удалением  ключей словаря.

Скрытый текст
Изменено: Nordheim - 20.08.2018 08:23:55
"Все гениальное просто, а все простое гениально!!!"
 
Вроде бы, быстрый макрос
Код
Sub МакросДублей()
    
    Sheets.Add(after:=Sheets(1)).Name = "Лист_дублей"
    Sheets(1).Select

    Dim lLastRow As Long, lLastCol As Long, i As Long, j As Long, k As Long, _
        arrayTable() As Variant, arrayTemp() As Variant
    
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    lLastCol = Cells(1, Columns.Count).End(xlToLeft).Column + 1
    
    Cells(1, lLastCol) = "№ п/п"
    Cells(2, lLastCol) = 1
    Cells(3, lLastCol) = 2
    Range(Cells(2, lLastCol), Cells(3, lLastCol)).AutoFill _
        Destination:=Range(Cells(2, lLastCol), Cells(lLastRow, lLastCol))
    Range(Cells(2, 1), Cells(lLastRow, lLastCol)).Sort _
        key1:=Range("G2:G" & lLastRow), order1:=xlAscending, Header:=xlNo
        
    arrayTable = Range(Cells(1, 1), Cells(lLastRow + 1, lLastCol)).Value
    ReDim arrayTemp(0 To lLastRow - 1, 1 To lLastCol)
    
    k = 1
    For i = 1 To lLastRow Step 1
        If arrayTable(i, 7) = arrayTable(i + 1, 7) _
            Or arrayTable(i, 7) = arrayTemp(k - 1, 7) _
        Then
            For j = 1 To lLastCol Step 1
                arrayTemp(k, j) = arrayTable(i, j)
            Next j
            k = k + 1
        End If
    Next i
    
    Sheets("Лист_дублей").Range("A1").Resize(k, lLastCol) = arrayTemp
    Range(Cells(1, 1), Cells(1, lLastCol)).Copy Sheets("Лист_дублей").Range("A1")
    Sheets("Лист_дублей").Range("G1").ColumnWidth = 12
    
    Range(Cells(2, 1), Cells(lLastRow, lLastCol)).Sort _
        key1:=Range(Cells(2, lLastCol), Cells(lLastRow, lLastCol)), _
        order1:=xlAscending, Header:=xlNo
    Range(Cells(1, lLastCol), Cells(lLastRow, lLastCol)).ClearContents
    
    Sheets("Лист_дублей").Select
End Sub
 
Цитата
dext написал:
Вроде бы, быстрый макрос
А вы его запускать пробовали на данном примере?
"Все гениальное просто, а все простое гениально!!!"
 
Конечно. А что Вас смутило?

P.S. Не совсем понимаю, что именно нужно mtts54 получить. Таблицу с дублями?
 
Доброе время суток.
Версия на SQL. На 15 столбцах 123000 дублей, 54000 уникальных - 26 секунд. То же на 60 столбцах 86 секунд. Явно проиграет алгоритму Владимиров :)
 
Цитата
Андрей VG написал: что Вас смутило?
Только то что дубли остаются на листе источнике.
"Все гениальное просто, а все простое гениально!!!"
 
dext, #45 (цитирование всего текста абсолютно бессмысленно и не нужно)
Цитата
dext: Вроде бы, быстрый макрос
на примере автора скорость замеряли? Если да, то озвучьте, пожалуйста, а если, нет, то тогда откуда такое предположение?
Цитата
dext: Не совсем понимаю, что именно нужно mtts54 получить
Цитата
mtts54: с помощью VBA найти и вырезать из данной таблицы строки с повторяющимися id и перенести их на другой лист
да вроде понятней некуда :D нужно найти все дубли в источнике по столбцу с id, вырезать соответствующие строки из источника и перенести на отдельный лист ;)

Nordheim, смутило же не Андрея…
Изменено: Jack Famous - 20.08.2018 12:38:17
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
Nordheim , смутило же не Андрея…
А я Андрей VG, и не цитировал, возможно, что то с интернетом не так  8-0
"Все гениальное просто, а все простое гениально!!!"
 
Добрый день, уважаемые форумчане. Попробовал на реальном файле 153 тыс строк макросы от Jack Famous  #38 и #44. Оба макроса отработали корректно за 7,5 мин. Попробовал также макрос от Андрей VG #48 - получил ошибку  :cry: (см. скрин). До макроса от sokol92 пока не добрался, но попробую обязательно. Спасибо всем за ответы и помощь!
Excel непознаваем как атом.
 
Цитата
sokol92: Иллюстрация к #39
благодарю! Буду разбираться…
Цитата
mtts54: макросы от  Jack Famous #38 и #44
не — это оба макроса от Nordheim))) моего в #38 только проверки, а в #44 вообще ничего  :D
Цитата
mtts54: До макроса от sokol92 пока не добрался
отпишитесь, как доберётесь — должно быть лучшее время  :idea:
Изменено: Jack Famous - 22.08.2018 10:18:53
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Добрый день! Протестировал макрос от  sokol92  (пост #43) на своем реальном файл в 153 тыс строк. Это бомба! Невероятно, время работы составило 4,4 сек! И все повторы найдены и перенесены на новый лист со своим форматом. Супер! Спасибо всем, кто откликнулся и принял участие в решении проблемы, и конечно sokol92 - Вам отдельное огромное спасибо!
Excel непознаваем как атом.
 
mtts54, собсна, что и требовалось доказать  :idea:

P.S.: ну у вас и пинг, конечно  :D
Изменено: Jack Famous - 28.08.2018 12:06:09
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Двигатель от Владимира (ZVI), моя только сборка. :)
Успехов!
Владимир
 
Теме почти 3 года... но не удержался, чтобы не прокомментировать.

В чем фишка (движок от ZVI)?
Стандартное использование словаря.
Ну только если сортировка в конце - оригинально, когда для переноса на новый лист будет 150 тысяч дубликатов из 153 тыс. строк одним сплошным диапазоном. Выигрыш по времени действительно сумашедший.
Изменено: Marat Ta - 14.04.2021 13:38:22
 
Цитата
sokol92 написал: Иллюстрация к #39
Добрый день! Подскажите, а как сделать чтобы дубликаты искались не по одному столбцу, а по нескольким? Например, если одинаковые значения в первом и пятом столбце тогда строка считается дублирующей.
 
Анна Казакова, создайте новую тему с примером и помогу
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Страницы: Пред. 1 2
Наверх