Страницы: 1
RSS
Создание нескольких умных таблиц с определенным кол-м строк с помощью макроса
 
Здравствуйте уважаемые форумчане,
Помогите пожалуйста решить проблему.
На листе1 есть таблица и в столбе "1" указано значение.
Нужно на другом листе создать с помощью макроса столько умных таблиц, сколько строк больше нуля в таблице на листе 1 с количеством строк указаных в ячейке.
Пожалуйста посмотрите файл. (на втором листе, то что должно быть в итоге)
Благодарю за помощь,
Марина

 
 
Код
Sub CreateTables()
    Dim arrData As Variant, arrNewTable As Variant, LO As ListObject, LastRow As Long, i As Long, n As Long

    With Worksheets("Sheet1")
        arrData = .Range("A1").CurrentRegion
    End With
    
    Application.ScreenUpdating = False
    With Worksheets("Sheet2")
        .Cells.Clear 'полностью очищаем Sheet2 (удаляем все данные с листа)
        For i = 2 To UBound(arrData)
            If arrData(i, 2) > 0 Then
                ReDim arrNewTable(1 To arrData(i, 2) + 1, 1 To 1)
                arrNewTable(1, 1) = "Column1"
                For n = 2 To UBound(arrNewTable)
                    arrNewTable(n, 1) = arrData(i, 1)
                Next n
                LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                If LastRow > 2 Then LastRow = LastRow + 1
                .Cells(LastRow, 1).Resize(UBound(arrNewTable, 1), 1) = arrNewTable
                .ListObjects.Add(xlSrcRange, .Range(.Cells(LastRow, 1).CurrentRegion.Address), False, xlYes, "TableStyleMedium2").Name = "Table" & .ListObjects.Count + 1
            End If
        Next i
    End With
    Application.ScreenUpdating = True
    
    MsgBox "Таблицы созданы!", vbInformation, "Конец"
End Sub
Изменено: New - 12.05.2022 00:13:12
 
Спасибо Вам, New :)
 
Здравствуйте,
Макрос работает замечательно, но возникла одна проблема.
В полученных таблицах будет еще один столбец, в котором указываются данные с другого листа. (см. в файле)
Нужно чтобы в этот столбец вносились все значения подходящие по условию.
Я хотела формулой, но файл работает отчень медленно.
Помогите пожалуйста добавить это в макрос.
Изменено: Marina55573 - 22.05.2022 02:14:54
 
См. файл
 
Огромное Вам спасибо.  :)
Я столько дней билась над этим.
Вы меня просто спасли.  :D  :D  :D
Еще раз спасибо Вам New.  
Страницы: 1
Наверх