Как скопировать одну таблицу в другую, используя listrow? - PullRequest
0 голосов
/ 18 февраля 2020

Я пытаюсь скопировать строки данных из разных таблиц, и обычно я настраиваю выпуклую подсчет строк и столбцов и пару уровней для циклов.

Однако, это современный способ go использует listrows. Я попытался просмотреть руководство, на которое всегда ссылаются в https://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tables

Однако я, кажется, пропускаю этот «sometable.listobject (1) .rows = дифференцируемый.listrow (1) .rows» примерно ...

Мой код

Sub GenerateOverview()
Dim MainWs As Worksheet
Set MainWs = Worksheets("Overview")
Dim mainTbl As ListObject
Set mainTbl = MainWs.ListObjects(1)

' Later add for each sheet ----

Dim ws As Worksheet
Set ws = Worksheets("ABD")   ' ABD to be replaced with activesheet.name LATER
Dim tbl As ListObject
Set tbl = ws.ListObjects(1)

Dim TopXRange As Integer
TopXRange = 10  ' to be changed to user defined range

Dim i As Integer
i = 0

For i = 1 To TopXRange
    mainTbl.DataBodyRange.Rows(i) = tbl.DataBodyRange.Rows(i)
      ' THIS only produces empty cells on maintbl and not the content from tbl. 
Next i

' end for each sheet ----

End Sub

Есть совет?

Рабочее решение для моей задачи ..

Sub GenerateOverview()
Dim MainWs As Worksheet
Set MainWs = Worksheets("Overview")
Dim mainTbl As ListObject
Set mainTbl = MainWs.ListObjects(1)

Dim ws As Worksheet
Dim TopXRange As Integer
TopXRange = 10
Dim i As Integer
i = 1
Dim tbl As ListObject
Dim newI
Dim mainRows As Integer

For Each ws In ThisWorkbook.Worksheets

    If ws.Name = MainWs.Name Then GoTo skip

    Set ws = Worksheets(ws.Name)
    Set tbl = ws.ListObjects(1)

    mainRows = mainTbl.ListRows.Count
    If mainRows = 0 Then mainRows = 1

    For i = newI To TopXRange

        mainTbl.ListRows.Add (mainRows)
        mainTbl.ListRows(mainRows).Range.Value = tbl.ListRows(i + 1).Range.Value

    Next i


skip:
Next
End sub 

1 Ответ

1 голос
/ 19 февраля 2020

Все еще не уверен, что следую. Возможно, вам нужно вставить строку во вторую таблицу перед переносом. Примерно так работает:

Sub x()

Dim t1 As ListObject, t2 As ListObject

Set t1 = Sheet1.ListObjects("Table1")
Set t2 = Sheet1.ListObjects("Table2")

t2.ListRows.Add (3) 'insert new row 3 into second table
t2.ListRows(3).Range.Value = t1.ListRows(4).Range.Value 'transfer to new row from first table

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...