Копирование массива в таблицу дает пустой первый столбец в VBA / Excel - PullRequest
0 голосов
/ 19 сентября 2019

Я новичок в VBA, поэтому надеюсь, что не задаю глупый вопрос.Проблема у меня заключается в следующем - я выборочно беру данные из таблицы 1 (я копирую всю таблицу в массив «campaign_info», а затем черри выбираю из нее то, что хочу из нее, в массив «calendar_info»), которую затем хочу заполнитьБазы данных второго стола (Таблица 4).Проблема в том, что данные, похоже, просто копируются в массив, но когда я копирую «Calendar_info» в тело таблицы 4, это дает мне пустой первый столбец и не копирует последний столбец (возможно, потому что заголовки статические, это нормально, я думал).Я не уверен, как сдвинуть все данные в один столбец влево, чтобы все это работало.Извините, если это простой вопрос, надеюсь, кто-то может мне помочь.Заранее спасибо!

Sub Button17_Click()

'load data into content calendar
Application.DisplayStatusBar = True
Dim campaign_info() As Variant
Dim calendar_info As Variant
Dim DataTable As ListObject
Dim lRowsAdj As Long




'call optimisation subroutine - better performance with screen update et al turned off
Call OptimizeCode_Begin

campaign_info = Worksheets("CPData").ListObjects("Table1").DataBodyRange.Value

ReDim calendar_info(UBound(campaign_info, 1), 7)

For x = LBound(campaign_info) To UBound(campaign_info)
    calendar_info(x - 1, 1) = campaign_info(x, 1)
    calendar_info(x - 1, 2) = campaign_info(x, 2)
    calendar_info(x - 1, 3) = campaign_info(x, 3)
    calendar_info(x - 1, 4) = campaign_info(x, 5)
    calendar_info(x - 1, 5) = campaign_info(x, 7)
    calendar_info(x - 1, 6) = campaign_info(x, 8)
    calendar_info(x - 1, 7) = campaign_info(x, 10)
Next x

Set DataTable = ThisWorkbook.Worksheets("Content Calendar").ListObjects(1)
With DataTable.DataBodyRange
    Rem Get Number of Rows to Adjust
    lRowsAdj = 1 + UBound(calendar_info, 1) - LBound(calendar_info, 1) - .Rows.Count

    Rem Resize ListObject
    If lRowsAdj < 0 Then
        Rem Delete Rows
        .Rows(1).Resize(Abs(lRowsAdj)).Delete xlShiftUp

    ElseIf lRowsAdj > 0 Then
        Rem Insert Rows
        .Rows(1).Resize(lRowsAdj).Insert Shift:=xlDown

End If: End With
Worksheets("Content Calendar").ListObjects("Table4").DataBodyRange.Value = calendar_info
Call OptimizeCode_End
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...