☰

VBA：建立新行並使用不同工作表中的資料自動填入它們

tag-icon • tag-icon microsoft-excel vba microsoft-excel-2016
VBA：建立新行並使用不同工作表中的資料自動填入它們

我有 2 張紙，其中包含以下資訊：

表B
項目1
項目2

表C
地點A
地點B
地點C

我試圖在 SheetA 中得到以下結果：

表A
項目1 位置A
項目1 位置B
項目1 位置
C 項目2
位置A 項目2 位置B
項目2 位置C

我使用此 vba 程式碼將項目從 SheetB 複製到 SheetA，但每個項目可以儲存在不同的位置，因此我想在 SheetA 中列出 SheetB 中的每個項目，以及 SheetC 中列出的所有可能位置。 SheetA 的想法是對所有資訊進行摘要。

Worksheets("SheetB").ListObjects("ArtikelDBTable").ListColumns("ARTIKEL").DataBodyRange.Copy _
Destination:=Worksheets("SheetA").ListObjects("WerbemittelTable").ListColumns("ARTIKEL").DataBodyRange

謝謝。

答案1

這是我找到的解決方案：

Sub Makro1()

    Dim i As Long
    Dim ii As Long
    Dim i3 As Long
    Dim i4 As Long
    Dim LastRowSht2 As Long
    Dim LastRowSht3 As Long
    Dim wb As Workbook
    Dim sht1 As Worksheet
    Dim sht2 As Worksheet

    Set wb = ThisWorkbook
    Set sht1 = wb.Sheets("Tabelle1")
    Set sht2 = wb.Sheets("Tabelle2")
    Set sht3 = wb.Sheets("Tabelle3")

    'Find the last row (in column A) with data.
    LastRowSht2 = sht2.Range("A:A").Find("*", searchdirection:=xlPrevious).Row
    LastRowSht3 = sht3.Range("A:A").Find("*", searchdirection:=xlPrevious).Row
    ii = 2
    i4 = 2

    For i = 2 To LastRowSht2

        For i3 = 2 To LastRowSht3
            sht1.Range("A" & ii) = sht2.Range("A" & i).Value
            sht1.Range("B" & ii) = sht3.Range("A" & i4).Value
            ii = ii + 1
            i4 = i4 + 1
        Next i3
        i4 = 2
    Next i
 End Sub

相關內容