l-freeman,
скачал книгу, выложенную Dmitri Krizhanovski для экспериментов.
запустил ваш код, поправленный до такого вида:
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
Sub i_freeman_0()
Dim MyWo As Workbook
Dim Slist$
Dim Frow&, Fcolumn&, Lrow&, Lcolumn&, y&, i&
'Set MyWo = DAOEx.Workbooks.Open("Workbook_sourse")
Set MyWo = ThisWorkbook
Slist = "test" '"list_sourse"
'-----------------------------------
With MyWo.Sheets(Slist)
Frow = .UsedRange.Row
Fcolumn = .UsedRange.Column
Lrow = .UsedRange.Row + .UsedRange.Rows.Count - 1
Lcolumn = .UsedRange.Column + .UsedRange.Columns.Count - 1
End With
'------------------------------------
Dim tt#
tt = Timer
For y = Fcolumn To Lcolumn
For i = Frow To Lrow
If MyWo.Sheets(Slist).Cells(i, y).Value = Empty Then MyWo.Sheets(Slist).Cells(i, y) = 0
Next i
Next y
Debug.Print "i_freeman_0", (Timer - tt)
End Sub
время работы на моем стареньком компьютере - 20.6 секунды
в выложенном примере задействован диапазон в 84 * 5708 = 479472
Чтобы только добраться до value с целью сравнения вы сначала 479472 говорите:
(на каждом шаге!!!)
Эксель, в книге MyWo найди лист с именем slist и на нем отыщи клетку с координатами i,y
У вас просто нет права рассчитывать на быстрое выполнение.
Хотите скорости -
научитесь выражаться короче.
ваша попытка
1.
2.
3.
For Each acc In Range(Cells(Frow, Fcolumn), Cells(Lrow, Lcolumn))
If acc = Empty Then Cells(acc.Row, acc.Column) = 0
Next acc
не просто неудачна, если она работает, то работает у вас случайно. Т.к. отношение имеет не к тому листу, который вы slist назвали, а к тому, в который сейчас глазками смотрите.
При этом это хуже первоначального варианта.
Там вы хоть точно знаете в какой книге искать.
А здесь вам не понравилось, что excel слишком быстро считает и вы решили наказать его за это, приказывая строкой Cells(acc.Row, acc.Column) = 0 следующее.
Эксель, всякий раз, когда найдешь в цикле обработки пустую клетку, определи,
в какой книге находится текущий лист, который я вижу глазами.
На этом листе найди клетку с координатами такими же, какие у текущей клетки
в цикле обработки (мы помним - откуда взятой - взятой из книги MyWo с листа slist), и в эту клетку (той книги, страницу которой я вижу глазами) запиши ноль.
Вы какого уроста ожидаете, если просите сделать работы больше, чем в своем первоначальном варианте? При этом не просто больше, а близко не то-же самое по смыслу.
Это издевательство какое-то, ничем не прикрытое. Толстый троллинг безответного экселя.
Начинаем сначала. Хотите скорости - научитесь разговаривать коротко.
Складываем "по складам":
клетки занятого диапазона листа slist книги MyWo == MyWo.Sheets(Slist).UsedRange
Для каждой клетки == For Each rr
Все вместе слитно: == For Each rr In MyWo.Sheets(Slist).UsedRange
Вот код, который должен у вас получиться.
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
Dim MyWo As Workbook
Dim Slist$
Set MyWo = DAOEx.Workbooks.Open("Workbook_sourse")
Slist = "list_sourse"
Dim rr As Range
Dim tt#
tt = Timer
'----------------------------
For Each rr In MyWo.Sheets(Slist).UsedRange
If IsEmpty(rr) Then rr.Value2 = 0
Next
Debug.Print "test_1_0", (Timer - tt)
Этот вариант у меня отрабатывает за 7 секунд против первоначальных 20.6
Еще
немного (около секунды на выложенном примере) можно сэкономить при выключении автоматического пересчета и обновления экрана.
В данном случае немного, т.к. доля обновляемых клеток в примере невелика.
Вариант, который предложил Bobgos отработает быстрее.
Но на больших объемах данных им следует пользоваться с некоторой осмотрительностью.
И помнить, что он критичнее по отношению к отключению пересчета и обновлению экрана, т.к. обновляется весь массив данных, а не некоторые клетки (предположительно - меньшинство).
такой вариант
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
Dim MyWo As Workbook
Dim Slist$
Set MyWo = DAOEx.Workbooks.Open("Workbook_sourse")
Slist = "list_sourse"
Dim rr As Range
Dim tt#
tt = Timer
'----------------------------
Dim v As Variant
Dim oldCalc
With Application
.ScreenUpdating = False
oldCalc = .Calculation
.Calculation = xlCalculationManual
End With
Set rr = MyWo.Sheets(Slist).UsedRange
v = rr.Value2
Dim iRow&, iCol&
For iRow = LBound(v, 1) To UBound(v, 1)
For iCol = LBound(v, 2) To UBound(v, 2)
If IsEmpty(v(iRow, iCol)) Then v(iRow, iCol) = 0
Next
Next
rr.Value2 = v
With Application
.ScreenUpdating = True
.Calculation = oldCalc
End With
Debug.Print "test_2", (Timer - tt)
на примере от Dmitri Krizhanovski
у меня отработал за 1.6 сек.
