Привет, я пытаюсь адаптировать превосходный VBA, который был опубликован ранее, чтобы просмотреть данные, взять все строки с одинаковым идентификатором в столбце 1 и добавить их все в одну строку для каждого. Попытка получить от этого:

Точка отсчета

К этому

Конечная точка

но приведенный ниже адаптированный код объединяет только 2 строки, даже если в столбце 1 их больше двух с одинаковым идентификатором.

Sub CombineInvoices()
Dim currentRow As Long
Dim currentCol As Long
Dim LastRow As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row 
currentCol = 4
For currentRow = LastRow To 2 Step -1
    If Cells(currentRow, 1) = Cells(currentRow - 1, 1) Then
        Range(Cells(currentRow, 1), Cells(currentRow, 4)).Copy Destination:=Range(Cells(currentRow - 1, currentCol + 1), Cells(currentRow - 1, currentCol + 4))
        Rows(currentRow).EntireRow.Delete
    End If
Next
currentCol = currentCol + 4
End Sub

Вся помощь действительно с благодарностью получена.

если вы переместите оператор currentCol = currentCol + 4

1 ответ1

0

Удалось решить это. Я удалял строки, когда собирался разделить операторы копирования и удаления, как показано ниже, и все работает! Ура!

Sub CombineRowsRevisitedStep()
Dim currentRow As Long
Dim currentCol As Long
Dim LastRow As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
currentCol = 4
For currentRow = LastRow To 2 Step -1
    If Cells(currentRow, 1) = Cells(currentRow - 1, 1) Then
        Range(Cells(currentRow, 1), Cells(currentRow, currentCol)).Copy Destination:=Range(Cells(currentRow - 1, 4), Cells(currentRow - 1, currentCol + 30))
    currentCol = currentCol + 4
    End If
Next
For currentRow = LastRow To 2 Step -1
    If Cells(currentRow, 1) = Cells(currentRow - 1, 1) Then
        Rows(currentRow).EntireRow.Delete
    End If
Next
End Sub

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .