☰

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

相关内容