将一行多列拆分为多行

Question

所以我选择了这个 VBA 代码...

Sub NewLayout()
    For i = 2 To Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
        For j = 0 To 2
        If Cells(i, 3 + j) <> vbNullString Then
            intCount = intCount + 1
            Cells(i, 1).Copy Destination:=Cells(intCount, 10)
            Cells(i, 2).Copy Destination:=Cells(intCount, 11)
            Cells(i, 3 + j).Copy Destination:=Cells(intCount, 12)
            Cells(i, 6 + j).Copy Destination:=Cells(intCount, 13)
        End If
        Next j
    Next i
End Sub

我遇到了以下情况，无法让宏顺利运行（因为我不习惯编写任何代码）。我一直在尝试弄清楚上面的代码，但对于列如何按该顺序工作，它根本说不通。有人可以帮忙吗？

我有这些数据

Company  Code      Store1   Store Hours1    Store2   Store Hours2    Store3   Store Hours3
90       920016    BAY0     40              BCR0     35              BES0     20
90       920052    BAY0     40              BCR0     35              BES0     20
90       920054    BAY0     40              BCR0     35              BES0     20
90       920058    BAY0     40              BCR0     35              BES0     20

我需要将各列排成一行，如下所示：

90       920016    BAY0    40
90       920016    BCR0    35
90       920016    BES0    20
90       920052    BAY0    40
90       920052    BCR0    35
90       920052    BES0    20
90       920054    BAY0    40
90       920054    BCR0    35
90       920054    BES0    20

也许有人能帮忙吗？

Answer 1

因此，我们不必进行数学运算，只需从第三列开始，每 2 步计算一次即可。这样计算起来会简单一些：

Sub NewLayout()
Dim ws As Worksheet
Dim i As Long, j As Long
Dim intCount As Long

For i = 2 To Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
    For j = 3 To 7 Step 2
        If Cells(i, j) <> vbNullString Then
            intCount = intCount + 1
            Cells(i, 1).Copy Destination:=Cells(intCount, 10)
            Cells(i, 2).Copy Destination:=Cells(intCount, 11)
            Cells(i, j).Copy Destination:=Cells(intCount, 12)
            Cells(i, j + 1).Copy Destination:=Cells(intCount, 13)
        End If
    Next j
Next i
End Sub