將具有多列的一行拆分為多行

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