VBA Excel列中的嵌套循环

Question

我需要从 A 列获取数据并将每个值添加到第 1 行中的学校。它应该都只是列。输入是：

Input data

我需要的输出是这样的：

School               SERVICE     Number of  Price
Granbacka skola      Computer    1          500
Granbacka skola      Ipads       25         600
Granbacka skola      Iphone      0          700
Granbacka skola      Ipad Swap   0          800
Granbacka skola      Iphone Swap 0          900
Granbacka skola      Service     0          1000
Bagartorps förskola  Computer    1          500
Bagartorps förskola  Ipads       0          600
Bagartorps förskola  Iphone      5          700
Bagartorps förskola  Ipad Swap   4          800
Bagartorps förskola  Iphone Swap 0          900
Bagartorps förskola  Service     1          1000
Ekensbergs skola     Computer    2          500
Ekensbergs skola     Ipads       0          600
Ekensbergs skola     Iphone      33         700
Ekensbergs skola     Ipad Swap   0          800
Ekensbergs skola     Iphone Swap 0          900
Ekensbergs skola     Service     0          1000
Frösunda skola       Computer    3          500
Frösunda skola       Ipads       0          600
Frösunda skola       Iphone      0          700
Frösunda skola       Ipad Swap   0          800
Frösunda skola       Iphone Swap 2          900
Frösunda skola       Service     0          1000

该代码将应用于多个工作簿和工作表，其中服务和学校的数量可能不同。

我试过写作和搜索，但找不到任何能解决我问题的东西。 谢谢！

//M

编辑 2017-05-30 - 更改了输入和输出示例以阐明我需要完成的工作。

Answer 1

更新代码，

Sub loopcols()
Dim i As Long, j As Long, k As Long, x As Long, y As Long
i = Cells(1, Columns.Count).End(xlToLeft).Column() - 2
j = Cells(Rows.Count, 1).End(xlUp).Row() - 1
Sheets.Add.Name = "newSheet"
x = 1
y = 1
For k = 1 To i * j
    If k Mod j <> 0 Then
        Sheets("newSheet").Cells(k, 1) = Cells(1, 2 + x)
        Sheets("newSheet").Cells(k, 2) = Cells(y + 1, 1)
        Sheets("newSheet").Cells(k, 4) = Cells(y + 1, 2)
        y = y + 1
    Else
        Sheets("newSheet").Cells(k, 1) = Cells(1, 2 + x)
        Sheets("newSheet").Cells(k, 2) = Cells(y + 1, 1)
        Sheets("newSheet").Cells(k, 4) = Cells(y + 1, 2)
        x = x + 1
        y = 1
    End If
Next k
x = 1
y = 3
For k = 1 To i * j
    Sheets("newSheet").Cells(k, 3) = Cells(x + 1, y)
    x = x + 1
    If k Mod j = 0 Then
        x = 1
        y = y + 1
    End If
Next k
Sheets("newSheet").Rows(1).Insert
Sheets("newSheet").Cells(1, 1) = "School"
Sheets("newSheet").Cells(1, 2) = Cells(1, 1)
Sheets("newSheet").Cells(1, 3) = "Number Of:"
Sheets("newSheet").Cells(1, 4) = Cells(1, 2)
End Sub