Добрый день. Необходимо по определенному списку в таблице Н,создать средствами VBA определенное количество отдельных таблиц по образцу первой. Например список на 6 строк в Таблице Н- делаем 6 таблиц - Таблица 1,2,3,4,5,6. Таблица №1 является примером для создания других таблиц, но фамилия проставляеться по первой строке. Файл пример прикрепляю.
Добрый день. Необходимо по определенному списку в таблице Н,создать средствами VBA определенное количество отдельных таблиц по образцу первой. Например список на 6 строк в Таблице Н- делаем 6 таблиц - Таблица 1,2,3,4,5,6. Таблица №1 является примером для создания других таблиц, но фамилия проставляеться по первой строке. Файл пример прикрепляю.kotrad3
With Sheets("Лист1").Range("A1").CurrentRegion x = .Value ReDim y(1 To UBound(x) * 3, 1 To 4) For i = 2 To UBound(x) nTbl = nTbl + 1 k = k + 1 y(k, 1) = nTbl y(k, 2) = x(i, 2) y(k, 3) = x(1, 3) y(k, 4) = x(i, 3) If x(i, 4) > 0 Then k = k + 1 y(k, 3) = x(1, 4) y(k, 4) = x(i, 4) End If Next i .Offset(, 5).Resize(k, 4).Value = y() End With End Sub
[/vba]
Возможно, как-то так: [vba]
Код
Sub ertert() Dim x, y(), i&, k&, nTbl&
With Sheets("Лист1").Range("A1").CurrentRegion x = .Value ReDim y(1 To UBound(x) * 3, 1 To 4) For i = 2 To UBound(x) nTbl = nTbl + 1 k = k + 1 y(k, 1) = nTbl y(k, 2) = x(i, 2) y(k, 3) = x(1, 3) y(k, 4) = x(i, 3) If x(i, 4) > 0 Then k = k + 1 y(k, 3) = x(1, 4) y(k, 4) = x(i, 4) End If Next i .Offset(, 5).Resize(k, 4).Value = y() End With End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
