Excel中的多维矩阵转置（宏）

我在Excel电子表格中有一些“多维”数据，目前如下所示：

我想将其转换为具有多列的行：

我尝试了多个宏，但仍然无法处理所有维度以正确转换为行，如果有任何帮助，我将不胜感激：）

p

以下代码在没有第三维度（销售类型）的情况下运行良好：

子测试（）
Dim inputRange作为范围，INPUTRARY作为变量
Dim outputRange作为范围，OUTPUTRAY（）作为变量
变暗的向外长，向内长，向内长
Set-inputRange=ThisWorkbook.Sheets（“Sheet1”）.范围（“A1:AA150”）
Set outputRange=ThisWorkbook.Sheets（“Sheet2”）.Range（“A1”）
inputray=inputRange.Value
ReDim输出数据线（1到（UBound（输入数据线，1）*UBound（输入数据线，2）），1到3）
outRow=0
对于inCol=2至UBound（输入端，2）
对于inRow=2至UBound（inputRRay，1）
如果inputray（inRow，inCol）vbNullString和inputray（inRow，inCol）0，则
outRow=outRow+1
outputRRay（outRow，1）=inputRRay（1，inCol）
outputRRay（outRow，2）=inputRRay（inRow，1）
outputRRay（outRow，3）=inputRRay（inRow，inCol）
如果结束
下一步
下一个国际贸易公司
使用outputRange.Resize（1,3）
.全部清除
.Value=数组（“存储”、“产品”、“数量”）
.Font.FontStyle=“粗体”
以
使用outputRange.Offset（1，0）。调整大小（UBound（OutputRay，1），UBound（OutputRay，2））
.Value=outputRRay
以
使用outputRange.Parent
使用范围（outputRange.Range（“a1”），.Cells（.Rows.Count，outputRange.Column）.End（xlUp））.Resize（，3）
.Borders（xlEdgeLeft）.LineStyle=xlContinuous
.Borders（xlEdgeTop）.LineStyle=xlContinuous
.Borders（xlEdgeBottom）.LineStyle=xlContinuous
.Borders（xlEdgeRight）.LineStyle=xlContinuous
.Borders（xlInsideVertical）.LineStyle=xlContinuous
.Borders（xlInsideHorizontal）.LineStyle=xlContinuous
.Columns.AutoFit
以
以
端接头

如果您特别想要VBA解决方案，那么我认为您的代码可能过于复杂了

您的范围定义看起来很奇怪。我不太明白，当数据仅在前7列中时，为什么选择列“A”到“AA”。数据传输应该只是一种循环行，然后循环每一列以传输到输出数组的情况。所需的代码如下所示。我省略了所有的格式设置，你可以根据自己的需要进行调整

似乎这段代码是从其他地方提取的，您已经尝试过对其进行调整。这很好，但它确实需要您理解原始代码在做什么，而且我也不清楚您是否有这种理解。如果您从头开始编写代码，以便知道循环将带您去哪里，您可能会获得更大的成功

Dim data As Variant
Dim fmt As String
Dim output() As Variant
Dim r As Long, x As Long, i As Long

'Define your range
With Sheet1
    data = .Range(.Range("A1"), _
                  .Range("A" & .Rows.Count).End(xlUp)) _
            .Resize(, 7) _
            .Value2
End With

'Redim output array based on range size.
'Note the + 1 for a header.
ReDim output(1 To UBound(data, 1) * 6 + 1, 1 To 4)

'Write the header.
output(1, 1) = "Product"
output(1, 2) = "Store"
output(1, 3) = "Sales Type"
output(1, 4) = "Qty"

'Transfer the data to output array.
i = 2 'index of ouput array
For r = 3 To UBound(data, 1)
    For x = 0 To 5 'loops the 5 columns in each row
        output(i + x, 1) = data(r, 1) 'product
        output(i + x, 2) = data(1, IIf(x < 3, 2, 5)) 'store
        output(i + x, 3) = data(2, x + 2) 'type
        output(i + x, 4) = data(r, x + 2) 'qty
    Next
    i = i + 6 'increment output index by 6 rows
Next

'Write output to sheet.
Sheet2.Range("A1") _
      .Resize(UBound(output, 1), _
              UBound(output, 2)) _
      .Value = output

Dim数据作为变量
作为字符串的Dim fmt
Dim output（）作为变量
变暗r为长，x为长，i为长
'定义您的范围
附页1
数据=.Range（.Range（“A1”）_
.Range（“A”和.Rows.Count）.End（xlUp））_
.Resize（，7）_
.价值2
以
'基于范围大小的Redim输出数组。
'注意页眉的+1。
重拨输出（1到UBound（数据，1）*6+1，1到4）
'写入标题。
输出（1，1）=“产品”
输出（1，2）=“存储”
输出（1，3）=“销售类型”
输出（1，4）=“数量”
'将数据传输到输出数组。
i=输出数组的2'索引
对于r=3至UBound（数据，1）
对于x=0到5'，循环每行中的5列
输出（i+x，1）=数据（r，1）'
输出（i+x，2）=数据（1，IIf（x<3，2，5））'存储
输出（i+x，3）=数据（2，x+2）类型
输出（i+x，4）=数据（r，x+2）数量
下一个
i=i+6'将输出索引增加6行
下一个
'将输出写入工作表。
表2.范围（“A1”）_
.调整大小（UBound（输出，1）_
UBound（输出，2））_
.值=输出

我建议尝试powerquery（获取和转换）。你能发布你已经尝试过的代码吗？不管有多错误，因为它会给我们提供一些工作依据。嗨，Ambie，我附上了代码：）我知道这很奇怪（我没有设计它）。我根据你的密码更正了马可。它就像一个符咒。谢谢！

Dim data As Variant
Dim fmt As String
Dim output() As Variant
Dim r As Long, x As Long, i As Long

'Define your range
With Sheet1
    data = .Range(.Range("A1"), _
                  .Range("A" & .Rows.Count).End(xlUp)) _
            .Resize(, 7) _
            .Value2
End With

'Redim output array based on range size.
'Note the + 1 for a header.
ReDim output(1 To UBound(data, 1) * 6 + 1, 1 To 4)

'Write the header.
output(1, 1) = "Product"
output(1, 2) = "Store"
output(1, 3) = "Sales Type"
output(1, 4) = "Qty"

'Transfer the data to output array.
i = 2 'index of ouput array
For r = 3 To UBound(data, 1)
    For x = 0 To 5 'loops the 5 columns in each row
        output(i + x, 1) = data(r, 1) 'product
        output(i + x, 2) = data(1, IIf(x < 3, 2, 5)) 'store
        output(i + x, 3) = data(2, x + 2) 'type
        output(i + x, 4) = data(r, x + 2) 'qty
    Next
    i = i + 6 'increment output index by 6 rows
Next

'Write output to sheet.
Sheet2.Range("A1") _
      .Resize(UBound(output, 1), _
              UBound(output, 2)) _
      .Value = output