Страницы: 1
RSS
Подсчет значений в диапазоне. Ускорить макрос
 
Доброго дня,
Есть вот такое "чудо-юдо". 1k строк обрабатывает без труда. 10k - уже достаточно медленно.
Подскажите, как можно ускорить и/или переделать то, что делает данный макрос.
Всем спасибо кто откликнется.
Код
Sub test()

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual

   Range("A1").Select
   Do While (Selection.Offset(1, 0) <> "")
   Selection.Offset(1, 0).Select
   Debug.Print Selection.Address

      Cells(ActiveCell.Row, "B").FormulaR1C1 = "=COUNTIF(C[-1],RC[-1])"
      Loop

Application.DisplayStatusBar = True

End Sub
 
Код
Sub test()
    Application.ScreenUpdating = False    'disable all screen updates
    Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).Offset(, 1).FormulaR1C1 = "=COUNTIF(C[-1],RC[-1])"
    Application.ScreenUpdating = True    'disable all screen updates
End Sub
 
Вариант на PQ.. Наверное, разворачивать вместо TransformColumns было бы быстрее
Код
let
    Src = Table.Buffer(Excel.CurrentWorkbook(){[Name="Table1"]}[Content]),
    Grp = Table.Buffer(Table.Group(Src, {"key"}, {{"Qty", each Table.RowCount(_), type number}})),
    Mer = Table.NestedJoin(Src,{"key"},Grp,{"key"},"Count", JoinKind.LeftOuter),
    Trf = Table.TransformColumns(Mer, {"Count", each _[Qty]{0}})
in
    Trf
Изменено: Alexey_Spb - 15.03.2019 18:42:30
 
При больших объёмах лучше вообще отказаться от формул
Код  RAN повесил ексель на миллионе строк.
Макросом обработал за 15с
00:00  считывание  массива 1041256 строк
00:02  обработка  массива 1041256 строк
00:01  Применение результатов  массива 1041256 строк
00:12  выгрузка  массива с результатами 1041256 строк
00:15 Всего времени
Код
Sub qwert()
    
   Dim r, lr, m, tt, ttt, u, sl: Set sl = CreateObject("Scripting.Dictionary")
   With ActiveSheet
   
        tt = Time
        ttt = Time
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        m = .Cells(1, 1).Resize(lr, 2)
        Debug.Print Format(Time - tt, "nn:ss") & "  считывание  массива " & UBound(m) & " строк"
        
        tt = Time
        For r = 2 To UBound(m)
            sl(m(r, 1)) = sl(m(r, 1)) + 1
        Next r
        Debug.Print Format(Time - tt, "nn:ss") & "  обработка  массива " & UBound(m) & " строк"
        
        tt = Time

        For r = 1 To UBound(m)
            m(r, 2) = sl(m(r, 1))
        Next r
        Debug.Print Format(Time - tt, "nn:ss") & "  Применение результатов  массива " & UBound(m) & " строк"
        
        tt = Time
        .Cells(1, 1).Resize(UBound(m), 2) = m
        Debug.Print Format(Time - tt, "nn:ss") & "  выгрузка  массива с результатами " & UBound(m) & " строк"
        Debug.Print Format(Time - ttt, "nn:ss") & " Всего времени "
        
   End With
End Sub
 

Доброго времени суток!

Утром, все посмотрел и оценил, масштаб.
@Александр Моторин, Код - отлично "отработал на >100k" строк. Задача выполнена.
@RAN, Спасибо большое. Я все сделал через "Loop", не знал, как применить ".End(xlUp)". Учусь. Теперь разобрался. Обязательно применю в отчете!
@Alexey_Spb, Спасибо, что откликнулись на помощь!

Всем отличных выходных!

 
Alex D, то что делает этот макрос , делает сводная таблица, которая  обработала за пару секунд лимон строк.
По вопросам из тем форума, личку не читаю.
 
Доброго времени суток,
@БМВ, так точно - сводная таблица решит задачу. Нужно было обыграть подругому.
@RAN, подскажите пожалуйста, как теперь поставить формулу в диапозон E2...E(n)? Сейчас это в диапозоне B2...B(n).
Никак не могу понять...как поменять значения. Фаил в приложении с макросами. (пример на листе2).
Всем спасибо и хорошего понедельника!
Код
Sub test()
    Application.ScreenUpdating = False    'disable all screen updates
    Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).Offset(, 1).FormulaR1C1 = "=COUNTIF(C[-1],RC[-1])"
    Application.ScreenUpdating = True    'disable all screen updates
End Sub
Страницы: 1
Наверх