将数据行复制到 Excel 中的另一个工作表并添加列 VBA

Question

我无法理解这一点。

我有一个这样的数据结构：

我想最终得到这样的东西（在另一张纸上）。

如果列 E 等于 2，则应将该行复制到另一张工作表，并将具有相同 ID 的行（A 列）与该行中的名称插入到最后一行中。

实际上，我正在尝试合并/合并 2 行，如图所示，这样每个 ID 号在 Sheet2 中只表示一次。

Sub Test()
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Sheet1")
    Dim i As Integer
    Dim last_row As Integer
    last_row = Application.WorksheetFunction.CountA(sh.Range("A:A"))
    For i = 2 To last_row
        If sh.Range("D" & i).Value = 2 Then
            sh.Range("A1:G3").Copy _
            Worksheets("sheet2").Range("A1")
        End If
    Next i
End Sub

目前，我只能复制一个范围。 然后我对执行子任务的顺序感到困惑。

Answer 1

这是使用字典来确保您不会复制相同 ID 的倍数。

我假设根据您的示例，您总是想要每个 id 的第一个实例。

    Dim sourcesh As Worksheet
    Dim destsh As Worksheet
    
    Set sourcesh = ThisWorkbook.Sheets("Sheet1")
    Set destsh = ThisWorkbook.Sheets("Sheet2")
    
    Dim i As Long
    Dim j As Long
    Dim lr As Long
    
    With sourcesh
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        Dim dict As Object
        Set dict = CreateObject("Scripting.Dictionary")
        j = 1
        For i = 2 To lr
            If .Cells(i, 4).Value = 2 Then
                If Not dict.exists(.Cells(i, 1).Value) Then
                    destsh.Cells(j, 1) = .Cells(i, 1)
                    destsh.Cells(j, 2) = .Cells(i, 2)
                    destsh.Cells(j, 4) = .Cells(i, 3)
                    destsh.Cells(j, 5) = .Cells(i, 4)
                    destsh.Cells(j, 6) = .Cells(i, 5)
                    destsh.Cells(j, 7) = .Cells(i, 6)
                    destsh.Cells(j, 8) = .Cells(i, 7)
                    
                    dict.Add .Cells(i, 1).Value, j
                    j = j + 1
                Else
                    destsh.Cells(dict(.Cells(i, 1).Value), 3) = .Cells(i, 2)
                End If
            End If
        Next i
    End With