в файле более 6000 строк - компьютер стал долго думать На листе обработка события - изменения столбца 1, в случае наступления события - выполнение функции fTotalSum [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Target.Count > 1 Then Exit Sub If Target.Row < 5 Then Exit Sub If Target.Column = 1 Then Range("A3").Value = fTotalSum End If If Target.Column = 2 Then Range("B3").Value = fTotalCheck End If End Sub
[/vba]
Вот сама функция функция fTotalSum [vba]
Код
Function fTotalSum() ScreenOff 'отключение обновления экрана, автопересчёта, событий Dim fLastRow As Integer Dim fJ As Integer, fS As Long, fX As Integer, fY As Long fTotalSum = 0 fLastRow = shAdmin.Cells(Rows.Count, 1).End(xlUp).Row
For fJ = 5 To fLastRow If shAdmin.Cells(fJ, 1) <> "" And IsNumeric(shAdmin.Cells(fJ, 1)) Then fX = shAdmin.Cells(fJ, 1) fY = shAdmin.Cells(fJ, 8) fS = fX * fY shAdmin.Cells(fJ, 9) = fS fTotalSum = fTotalSum + fS Else: shAdmin.Cells(fJ, 9).ClearContents End If Next fJ
ScreenOn End Function
[/vba]
чего можно сделать? [moder]В следующий раз пользуйтесь спецтегами (кнопка #). Сейчас поправил.
в файле более 6000 строк - компьютер стал долго думать На листе обработка события - изменения столбца 1, в случае наступления события - выполнение функции fTotalSum [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Target.Count > 1 Then Exit Sub If Target.Row < 5 Then Exit Sub If Target.Column = 1 Then Range("A3").Value = fTotalSum End If If Target.Column = 2 Then Range("B3").Value = fTotalCheck End If End Sub
[/vba]
Вот сама функция функция fTotalSum [vba]
Код
Function fTotalSum() ScreenOff 'отключение обновления экрана, автопересчёта, событий Dim fLastRow As Integer Dim fJ As Integer, fS As Long, fX As Integer, fY As Long fTotalSum = 0 fLastRow = shAdmin.Cells(Rows.Count, 1).End(xlUp).Row
For fJ = 5 To fLastRow If shAdmin.Cells(fJ, 1) <> "" And IsNumeric(shAdmin.Cells(fJ, 1)) Then fX = shAdmin.Cells(fJ, 1) fY = shAdmin.Cells(fJ, 8) fS = fX * fY shAdmin.Cells(fJ, 9) = fS fTotalSum = fTotalSum + fS Else: shAdmin.Cells(fJ, 9).ClearContents End If Next fJ
ScreenOn End Function
[/vba]
чего можно сделать? [moder]В следующий раз пользуйтесь спецтегами (кнопка #). Сейчас поправил.kaiser-id
Сообщение отредактировал kaiser-id - Воскресенье, 11.05.2014, 18:31
А где у Вас текст процедур ScreenOff и ScreenOn? В них-то всё и дело скорее всего. Правда, не понятно, зачем эти простейшие действия оформлять отдельными процедурами, когда достаточно записи в одну строчку отключения и включения всех "тормозилок": вместо ScreenOff [vba]
Код
With Application: .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual: End With
[/vba]а вместо ScreenOn [vba]
Код
With Application: .EnableEvents = True: .ScreenUpdating = True: .Calculation = xlAutomatic: End With
[/vba]
А где у Вас текст процедур ScreenOff и ScreenOn? В них-то всё и дело скорее всего. Правда, не понятно, зачем эти простейшие действия оформлять отдельными процедурами, когда достаточно записи в одну строчку отключения и включения всех "тормозилок": вместо ScreenOff [vba]
Код
With Application: .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual: End With
[/vba]а вместо ScreenOn [vba]
Код
With Application: .EnableEvents = True: .ScreenUpdating = True: .Calculation = xlAutomatic: End With
Более того, цикл тут вообще не нужен. Конечно он тормознутый - Вы каждую итерацию обращаетесь к 2-м ячейкам и меняете значение третьей. Все гораздо проще. Файл положите - покажу как. Или не я, а еще кто-нибудь.
Более того, цикл тут вообще не нужен. Конечно он тормознутый - Вы каждую итерацию обращаетесь к 2-м ячейкам и меняете значение третьей. Все гораздо проще. Файл положите - покажу как. Или не я, а еще кто-нибудь._Boroda_
Не к двум, а к четырём - к одной правда три раза, но это тоже считается И кроме того для счётчика строк Integer не годится, используйте Long. Но это конечно на 6000 не сыграет, а вот к середине самого маленького листа - почувствуете.
Не к двум, а к четырём - к одной правда три раза, но это тоже считается И кроме того для счётчика строк Integer не годится, используйте Long. Но это конечно на 6000 не сыграет, а вот к середине самого маленького листа - почувствуете.Hugo
всем спасибо за рекомендации! выкладываю файл целиком, он ещё не готов, но с учётом уровня знаний, - уверен там уже очень много ложных алгоритмов, которые замедляют работу. http://yadi.sk/d/zHt-YxB2Q6nwZ
немного о файле оставил меньше чем 6000 строк, дома нормально по скорости считает, а на рабочем ПК медленно (там ноутбук с Core2Duo 1.8 ГГц, вроде не прошлый век ещё) на первом листе - в столбце "А" вводиться количество товара, далее скрипт считает общую сумму, вот на подсчёте и тупит и доступны разные операции с выбранными пунктами
всем спасибо за рекомендации! выкладываю файл целиком, он ещё не готов, но с учётом уровня знаний, - уверен там уже очень много ложных алгоритмов, которые замедляют работу. http://yadi.sk/d/zHt-YxB2Q6nwZ
немного о файле оставил меньше чем 6000 строк, дома нормально по скорости считает, а на рабочем ПК медленно (там ноутбук с Core2Duo 1.8 ГГц, вроде не прошлый век ещё) на первом листе - в столбце "А" вводиться количество товара, далее скрипт считает общую сумму, вот на подсчёте и тупит и доступны разные операции с выбранными пунктамиkaiser-id
Dim i As Long ReDim fRes(LBound(fArray1) To UBound(fArray1)) For i = LBound(fArray1) To UBound(fArray1) If IsNumeric(fArray1(i, 1)) And IsNumeric(fArray8(i, 1)) Then 'And fArray1(i, 1) >= 1 fRes(i) = fArray1(i, 1) * fArray8(i, 1) Else: fRes(i) = 0 End If Next fRes = Application.Transpose(fRes) shAdmin.Range(shAdmin.Cells(5, 9), shAdmin.Cells(fLastRow, 9)) = fRes
Dim fDiapason As Variant For Each fDiapason In fRes fTotalSum = fTotalSum + fDiapason Next fDiapason
With Application: .EnableEvents = True: .ScreenUpdating = True: .Calculation = xlAutomatic: End With End Function
[/vba]
в ScreenOff и ScreenOn то же самое что и у вас было ну, вроде, разобрался, без цикла, так быстрей
[vba]
Код
Function fTotalSum() With Application: .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual: End With
Dim fLastRow As Long fLastRow = shAdmin.Cells(Rows.Count, 1).End(xlUp).Row
Dim fArray1 As Variant Dim fArray8 As Variant Dim fRes()
Dim i As Long ReDim fRes(LBound(fArray1) To UBound(fArray1)) For i = LBound(fArray1) To UBound(fArray1) If IsNumeric(fArray1(i, 1)) And IsNumeric(fArray8(i, 1)) Then 'And fArray1(i, 1) >= 1 fRes(i) = fArray1(i, 1) * fArray8(i, 1) Else: fRes(i) = 0 End If Next fRes = Application.Transpose(fRes) shAdmin.Range(shAdmin.Cells(5, 9), shAdmin.Cells(fLastRow, 9)) = fRes
Dim fDiapason As Variant For Each fDiapason In fRes fTotalSum = fTotalSum + fDiapason Next fDiapason
With Application: .EnableEvents = True: .ScreenUpdating = True: .Calculation = xlAutomatic: End With End Function
Ну как же без цикла? А цикл по массиву не считается? Ну и ресурсоёмкую операцию [vba]
Код
fRes = Application.Transpose(fRes)
[/vba] можно сделать лишним, если [vba]
Код
ReDim fRes(LBound(fArray1) To UBound(fArray1), 1 to 1)
[/vba] и соответственно заполнять [vba]
Код
fRes(i,1)
[/vba]
Ну и ScreenUpdating действительно можно не отключать - т.к. из действий на листе всего одна выгрузка из массива. В итоге отключение/включение обновления экрана только немного тормозит весь процесс.
Ну как же без цикла? А цикл по массиву не считается? Ну и ресурсоёмкую операцию [vba]
Код
fRes = Application.Transpose(fRes)
[/vba] можно сделать лишним, если [vba]
Код
ReDim fRes(LBound(fArray1) To UBound(fArray1), 1 to 1)
[/vba] и соответственно заполнять [vba]
Код
fRes(i,1)
[/vba]
Ну и ScreenUpdating действительно можно не отключать - т.к. из действий на листе всего одна выгрузка из массива. В итоге отключение/включение обновления экрана только немного тормозит весь процесс.Hugo
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
