Макрос тормозит

[valerij]

Сообщение от alex77755

Дубли могут быть?
И оставлять как? По порядку в колонке или напротив в колонке А?

Могут и в А, и в В, но если один раз нашёл, в А-А, вторично можно не искать.
Найденное значение, достаточно одного раза.
Не важно, как удобней.

[alex77755]

Ну как-то так.
Твой макрос привёл в читабельный вид.
Но алгоритм = шедевр!

[valerij]

Сообщение от alex77755

Ну как-то так.
Твой макрос привёл в читабельный вид.
Но алгоритм = шедевр!

Сейчас попробую на полную...

alex77755
Ну поясни мне, че не так я делал?

Проверил, всё ОК, 2 минуты делал.

Та там действительно для меня тёмный лес...
И пояснять не надо.

Спасибо.

(\__/)
(='.'=)
E[:]|||[:]З
(")_(")

[alex77755]

При таких объёмах даже читать построчно нельзя.
А тут в каждой строке два считывания
А строк 531552 да умножить на к-во строк во второй колонке....
Считывание и запись самые медленные операции
Да ещё удаление со сдвигом огромного массива
Только массивы!
Считали одной строкой и выгрузили одной строкой.
Всё остальное в массиве.
Там в коде можно ещё ускорить: не гнать второй цикл до кона строк первого столбца, а выйти из цикла при пустом значении

    For R = 1 To LR 'идем по второму столбцу
    If M(R, 2) = "" Then Exit For

[valerij]

Сообщение от alex77755

При таких объёмах даже читать построчно нельзя.
А тут в каждой строке два считывания
А строк 531552 да умножить на к-во строк во второй колонке....
Считывание и запись самые медленные операции
Да ещё удаление со сдвигом огромного массива
Только массивы!
Считали одной строкой и выгрузили одной строкой.
Всё остальное в массиве.
Там в коде можно ещё ускорить: не гнать второй цикл до кона строк первого столбца, а выйти из цикла при пустом значении

    For R = 1 To LR 'идем по второму столбцу
    If M(R, 2) = "" Then Exit For

Я подозревал о массивах, даже когда из 531552 оставлял 53, удивился времени работы, как будто и не удалял.
А потом обратил внимание на вертикальную полосу прокрутки, при 53 строк она малюсенькая как и при 531552 и когда удали пустые строки, и прокрутка здоровенная и работал мухой.

Но с массивами не сталкивался, придётся почитать.

Щас код поменяю...

Спасибо за объяснения.

[IgorGO]

Sub DelNoFind()
  Dim rgA As Range, r As Long, a()
  a = Cells(1, 2).Resize(WorksheetFunction.CountA(Columns(2)), 1).Value
  Set rgA = Cells(1, 1).Resize(WorksheetFunction.CountA(Columns(2)), 1)
  For r = 1 To UBound(a)
    If WorksheetFunction.CountIf(rgA, a(r, 1)) = 0 Then a(r, 1) = Empty
  Next
  Cells(1, 2).Resize(UBound(a), 1).Value = a
  Columns(2).SpecialCells(xlCellTypeBlanks).Delete shift:=xlUp
End Sub

Валера, пока не вник очень сильно, пробуй может это сработает?

[valerij]

Сообщение от alex77755

Там в коде можно ещё ускорить: не гнать второй цикл до кона строк первого столбца, а выйти из цикла при пустом значении

    For R = 1 To LR 'идем по второму столбцу
    If M(R, 2) = "" Then Exit For

alex77755
Докладаю.
В первом варианте остаётся в В-В из 378 987 строк 179 321 строка.
Во втором варианте, быстрее работает ~ минута, остаётся 281 992 строки.
Кому верить?
Я правильно заменил, вроде по другому и нет?

For r = 1 To LR 'идем по второму столбцу
    If M(r, 2) = "" Then Exit For
    
    'For r = 1 To LR 'идем по второму столбцу
       'If oD.Exists(M(r, 2)) Then ' если есть в словаре

Сообщение от IgorGO

Валера, пока не вник очень сильно, пробуй может это сработает?

Игорь, проверил, ждал 6 минут, остановил процесс.
Если надо точное время то завтра, вернее сегодня, пора в люлю.

[alex77755]

Значит данные во втором столбце идут не по порядку, а где-то есть пустая ячейка. По ней и выход из цикла.
Кстати вчера уже вечером дошло: метки в колонке С не соответствуют.
Не тот индекс я поставил. Сейчас найду файл поправлю. Если метка нужна конечно.
Вот только если нужна и есть дубли, то метить все или только первую, или только последнюю?

[alex77755]

Что бы не учитывать пустые строки в В, но и не гнать по всему списку добавил строку определения количества записей во второй колонке.
Так же поправил пометки тех кто совпал.
Сейчас помечаются первые из дублей

но если один раз нашёл, в А-А

Вот именно в этом и превосходство словаря: не ищется, а просто проверяется наличие. Причем довольно быстро.
Вот если надо подсчитать количество дублей в А-А, или все дубли пометить, то надо ещё добавить пару строк в код

Sub QWERT()
Dim oD: Set oD = CreateObject("Scripting.Dictionary")
Dim oE: Set oE = CreateObject("Scripting.Dictionary")
Dim M(), LR, R, D, U(), LR2
With Лист1
    LR = .Cells(.Rows.Count, 1).End(xlUp).Row
    M = .Range("A1:C" & LR) 'грузим в массив
    
    For R = 1 To LR ' берём в словарь столбец А
'       oD(M(R, 1)) = R ' в таком случае метка будет на последнем из дублей
       If Not oD.Exists(M(R, 1)) Then oD(M(R, 1)) = R   ' в таком случае метка будет на первом из дублей
    Next R
'    для расстановки меток по всем дублям надо добавить небольшой блок

    LR2 = .Cells(.Rows.Count, 2).End(xlUp).Row
    For R = 1 To LR2 'идем по второму столбцу
       If oD.Exists(M(R, 2)) Then ' если есть в словаре
            oE(M(R, 2)) = R 'Добавляем в словарь совпавших что бы были по порядку
            M(oD(M(R, 2)), 3) = 0 ' ставим метку
       End If
       M(R, 2) = "" ' удаляем из колонки В
    Next R
    
  .Range("A1:C" & LR) = M ' Выгружаем массив на лист
  
' осталось показать совпавшие. Они в словаре. Можно былобы воспользоваться Transpose
'Но у него ряд ограничений. Так что массивом опять
  U = oE.keys 'словарь  в промежуточный массив
  ReDim M(UBound(U), 1 To 1)
  For R = 0 To UBound(U)
    M(R, 1) = U(R)
  Next R
.Range("B1").Resize(UBound(U) + 1) = M
End With
End Sub

[valerij]

Сообщение от alex77755

Значит данные во втором столбце идут не по порядку, а где-то есть пустая ячейка. По ней и выход из цикла.
Кстати вчера уже вечером дошло: метки в колонке С не соответствуют.
Не тот индекс я поставил. Сейчас найду файл поправлю. Если метка нужна конечно.
Вот только если нужна и есть дубли, то метить все или только первую, или только последнюю?

alex77755
Нет там пустой ячейки, это же данные после нашего отсева.
Вот сам взгляни - Rez.txt - В-В, а файл 16_737.txt - А-А
https://yadi.sk/d/iqmxmsN3cLbg8

Метка обязательна нужна или найденные файлы должны быть строго против = ячеек в А-А, это даёт мне ориентацию по адресам в HEX редакторе, тороплюсь на работу, часа через 4 буду.
Спасибо.

alex77755
Проверил макрос всё сошлось с первым - 179 321 строка, время ~ минута, для гарантии ещё можно подсчитать количества нулей, ну я с этим справлюсь - отдельным макросом.

For x = 1 To 531552
If Cells(x, 3) = "" Then
Else
Z = Z + 1
End If
Next
MsgBox Z

Z = 179 321 Всё ОК!!