Question

我目前拥有以下格式的数据：

Name 1 | Email 1 | ID 1 | Address 1 Street | Address 1 Suburb | Address 1 City | Address 2 Street | Address 2 Suburb | Address 2 City | Address 3 Street | Address 3 Suburb | Address 3 City
<NEW LINE>
Name 2 | Email 2 | ID 2 | Address 1 Street | Address 1 Suburb | Address 1 City | Address 2 Street | Address 2 Suburb | Address 2 City

等

我需要它看起来如下：

Name 1 | Email 1 | ID 1 | Address 1 Street | Address 1 Suburb | Address 1 City
<NEW LINE>
Name 1 | Email 1 | ID 1 | Address 2 Street | Address 2 Suburb | Address 2 City
<NEW LINE>
Name 1 | Email 1 | ID 1 | Address 3 Street | Address 3 Suburb | Address 3 City
<NEW LINE>
Name 2 | Email 2 | ID 2 | Address 1 Street | Address 1 Suburb | Address 1 City
<NEW LINE>
Name 2 | Email 2 | ID 2 | Address 2 Street | Address 2 Suburb | Address 2 City

等

到目前为止，我在电子表格中的A列是一个COUNTA公式，用于计算每行下方需要插入的行数，以便重复计算数据，这是正常的。由此我使用以下代码插入这些行也正常工作。

Sub ProcessAddressLabels()
For N = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
    If Cells(N, 1) <> "" And Cells(N, 1) <> 1 Then
            Rows(N + 1 & ":" & N + Cells(N, 1) - 1).Insert
            NumValues = Cells(N, 1)
    End If
Next N
End Sub

我不确定这里是如何从末尾复制每组3个单元格，并将其与重复的用户数据一起放在下面的行中！

非常感谢任何帮助，我希望我能够解释得这么简单！

Answer 1

但是，我不能说我完全理解你的所有需求会有这样的帮助：

Dim sht As Worksheet
Set sht = ActiveSheet
' copy the range C1:F1 to the start of the third row.
sht.range("C1:F1").Copy Destination:=Worksheets("Sheet1").range("A3")

Answer 2

尝试一下：

Sub Test()

   Dim rw As Range, n As Long, i As Long, x As Long

   Set rw = ActiveSheet.Rows(1) 'starting row

   Do While rw.Cells(1).Value <> ""
        'how many sets of addresses to move?
        x = Application.Ceiling((Application.CountA(rw) - 6) / 3, 1)
        If x > 0 Then
            'insert required rows
            rw.Offset(1, 0).Resize(x).Insert
            For i = 1 To x
                'copy common cells
                rw.Cells(1).Resize(1, 3).Copy rw.Cells(1).Offset(i, 0)
                'cut each address block
                rw.Cells(7 + ((i - 1) * 3)).Resize(1, 3).Cut rw.Cells(1).Offset(i, 3)
            Next i
        End If
        'move to next "new" row
        Set rw = rw.Offset(1 + x, 0)
   Loop

End Sub

使用VBA宏将数据从多列中移动到Excel下方的空白行

2 个答案: