Блог

Я не могу разобраться в этом.

У меня такая структура данных:

Я хотел бы получить что-то вроде этого (на другом листе).

Если столбец E эквивалентен 2, то строка должна быть скопирована на другой лист, а строка с тем же идентификатором (столбец A) имя в этой строке должно быть вставлено в последнюю строку.

На самом деле, я пытаюсь объединить / объединить 2 строки, как показано на рисунке, так, чтобы каждый идентификационный номер был представлен только один раз на листе 2.

 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" amp; i).Value = 2 Then
            sh.Range("A1:G3").Copy _
            Worksheets("sheet2").Range("A1")
        End If
    Next i
End Sub
 

На данный момент я могу скопировать только диапазон.
И тогда я не понимаю, в каком порядке выполнять подзадачи.

Это использует словарь, чтобы убедиться, что вы не копируете кратные одному и тому же идентификатору.

Я предполагаю, что на основе вашего примера вам всегда нужен первый экземпляр каждого идентификатора.

     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