Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Хитрое объединение таблиц
 
Цитата
JayBhagavan написал:
Пробуйте.
Выдает странную ошибку - 400.
Хитрое объединение таблиц
 
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
Изменено: volfram - 10.12.2015 15:08:39 (забыл загрузить файл)
Хитрое объединение таблиц
 
Пример в аттаче.
Исходные таблицы и какой результат нужен.

Там все подписано. Нужно решение, которое сможет работать достаточно быстро (больше 100 тыс. строк в результате)
Хитрое объединение таблиц
 
Есть три таблицы:

Таблица 1. Города
Город Транслит
Москва Mowscow
Тула Tula
Калуга Kaluga

Таблица 2. Транспорт
Тип транспорта
Трамвай
Троллейбус
Автобус
Маршрутка

Таблица 3. Цвет
Цвет Перевод
Красный Red
Зеленый green
Синий blue
Черный black
Бежевый yellow


Задача.
Сделать одну таблицу, в которой объединить все эти данные, по типу сочетания каждый с каждым.

В нашем примере - 3 строки в первой таблице, 4 во второй и 5 в третьей, значит строк должно быть: 60 (3*4*5)

Столбцов: 2 + 1 + 2
То есть для каждого города сделать перебор каждого транспорта с каждым цветом.
Столбцы будут такие:
Город, Транслит, Тип Транспорта, Цвет, перевод

Примеры строк
Москва Moscow Трамвай Красный Red
Москва Moscow Трамвай Зеленый green
Москва Moscow Трамвай Синий blue
...
Москва Moscow Троллейбус Красный Red
Москва Moscow Троллейбус Зеленый green
....и так далее.

Я сделал такое на циклах VBA, но работает это медленно. У меня в каждой таблице много записей и таблиц больше, поэтому финальный результат на примерно 130
тыс. строк получается.

Подскажите, куда копать?
Страницы: 1
Наверх