SLAVICK, спасибо!
Все работает.
Теперь дополняю ваш код, что бы делать это с таблицами, которые постоянно меняют свой размер, дописываются строки, добавляются столбцы.
Сделал такой код:
Код |
---|
Sub d()
Dim a(), b(), c(), ax()
Dim full(), i&, ii&, iii&, t&
'определяем ширину таблиц
Dim x&, y&, z&
x = Sheets("Источник").Cells.Find("*", [a1], xlFormulas, 1, 2, 2).Column
y = Sheets("Источник 2").Cells.Find("*", [a1], xlFormulas, 1, 2, 2).Column
z = Sheets("Источник 3").Cells.Find("*", [a1], xlFormulas, 1, 2, 2).Column
'задаем массивы
a = Sheets("Источник").[a3:c7].Value
b = Sheets("Источник 2").[a3:a6].Value
c = Sheets("Источник 3").[a3:b7].Value
ax = Sheets("Источник").[a1:c1].Value
ReDim full(1 To UBound(a) * UBound(b) * UBound(c), 1 To 10)
For i = 1 To UBound(a)
For ii = 1 To UBound(b)
For iii = 1 To UBound(c)
t = t + 1
Count = 1
'заполняем элементы массива
For g = 1 To x
full(t, Count) = a(i, g)
Count = Count + 1
Next g
For g = 1 To y
full(t, Count) = b(ii, g)
Count = Count + 1
Next g
For g = 1 To z
full(t, Count) = c(iii, g)
Count = Count + 1
Next g
Next iii, ii, i
Sheets.Add
Sheets(1).Activate
'Sheets(1).Range(Cells(1, 1), Cells(1, 3)) = ax()
Sheets(1).[a3].Resize(UBound(full), x + y + z) = full
Sheets(1).Cells(1, 1) = x
Sheets(1).Cells(1, 2) = y
Sheets(1).Cells(1, 3) = z
End Sub
|
Столкнулся с двумя проблемами.
1) Не могу понять, как задать гибко границы массива:
Код |
---|
Sheets("Источник").[a3:c7].Value |
Как подменять [a3:c7] на нужные мне переменные, например через Cells(3,1),Cells(7,1 + x)
2) Если разкомментировать эту строчку, начинает выдавать ошибку. Что не так?
Код |
---|
'Sheets(1).Range(Cells(1, 1), Cells(1, 3)) = ax
|