Добрый день.
Сейчас опишу ситуацию и вы увидете, к чему название топика.
Есть два листа в Excel. В одном примерно такая структура
ТитулИмяНомерАпрель 2009Май 2009Июнь 2009Июль 2009и тд до 2015 года21Строительство котлована345-прт-4437.АС103345.444454.010000.00.0и тд
Строк много.
Необходимо на втором листе транспонировать данные по периодам(датам) в таблицу.
ТитулИмяНомерДатаСумма21Строительство котлована345-прт-4437.АСАпрель 2009103345.421Строительство котлована345-прт-4437.АСМай 200944454.0
и тд.
Из соображений скорости делается все это таким кодом, используя массивы. Я привел примеры, однако исходной информации гораздо больше, поэтому в коде указываю только основное.
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.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
Function GetFromSomeList(FromSheet As String, LastRow As Integer, StartY As Integer, EndY As Integer)
Dim Smeta As Worksheet, From As Worksheet
Dim BigArr() As Variant, CurArr() As Variant, ba As Variant, a As Variant
Set Smeta = Worksheets("СМЕТЫ")
Set From = Worksheets(FromSheet)
ReDim BigArr(1)
BigArr(1) = Empty
...
For i = 7 To 1000
ReDim CurArr(1)
If From.Cells(i, 1).Interior.Color = ColorConstants.vbWhite Then 'Выгружаем только те значения, у которых фон = белый
For y = StartY To EndY Step 4 ' Объединенные ячейки с периодом и выполнением
c11 = CDate(From.Cells(3, y).Value) ' И ниже трансформируем в нужный формат даты
c12 = 0
c12 = CCur(From.Cells(i, y).Value)
If с12 <> 0 Then
If Not IsEmpty(CurArr(1)) Then ReDim Preserve CurArr(UBound(CurArr) + 1)
CurArr(UBound(CurArr)) = Array(c11, c12) 'Пишем дату и сумму для транспонирования в массив
End If
Next y
If Not IsEmpty(CurArr(1)) Then
...
'Добавим данные в массив
If Not IsEmpty(BigArr(1)) Then ReDim Preserve BigArr(UBound(BigArr) + 1)
BigArr(UBound(BigArr)) = Array(c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, CurArr, c14, c15, c16)
'c1,c2 и тд, кроме CurArr - это ячейки, которые берутся из первого листа, т.е. для одной строки - несколько значений (дата,сумма)
End If
End If
Next i
Erase CurArr
'Пишем на другой лист
y = LastRow
For Each ba In BigArr
For Each a In ba(11)
Smeta.Cells(y, 1).Value = ba(1)
Smeta.Cells(y, 2).Value = ba(2)
Smeta.Cells(y, 3).Value = ba(3)
Smeta.Cells(y, 4).Value = ba(4)
Smeta.Cells(y, 5).Value = ba(5)
Smeta.Cells(y, 6).Value = ba(6)
Smeta.Cells(y, 7).Value = ba(7)
Smeta.Cells(y, 8).Value = ba(8)
Smeta.Cells(y, 9).Value = ba(9)
Smeta.Cells(y, 10).Value = ""
Smeta.Cells(y, 11).Value = a(1) 'Вот оно транспонирование
Smeta.Cells(y, 12).Value = a(2)
Smeta.Cells(y, 13).Value = a(3)
Smeta.Cells(y, 14).Value = ba(12)
Smeta.Cells(y, 15).Value = ba(13)
Smeta.Cells(y, 16).Value = ba(14)
y = y + 1
Next a
Next ba
ba = Empty
a = Empty
Erase BigArr
Set Smeta = Nothing
Set From = Nothing
GetFromSomeList = y - 1
End Function
Проблема: выгружаются не все данные. По дебагеру, показывает что BigArr имеет максимально 133 элемента. То есть фактически обработано только 133 строки из первого листа, а их там около 700.
При проверке - и правда не все данные выгружаются.
Вопрос - есть ограничение на массивы и как в данном случае поступить - что то сделать с массивами или забить на скорость и грузить сразу в лист?
