Question

我有一些＆＃34;多维＆＃34; Excel电子表格中的数据，如下所示：

我希望将其转换为包含多列的行：

我尝试了多个宏但仍无法处理所有维度以正确转置到行，非常感谢任何帮助：）

P上。

这里的代码在没有第三维（销售类型）的情况下效果很好：

Sub test()
    Dim inputRange As Range, inputRRay As Variant
    Dim outputRange As Range, outputRRay() As Variant
    Dim outRow As Long, inCol As Long, inRow As Long

    Set inputRange = ThisWorkbook.Sheets("Sheet1").Range("A1:AA150")
    Set outputRange = ThisWorkbook.Sheets("Sheet2").Range("A1")

    inputRRay = inputRange.Value
    ReDim outputRRay(1 To (UBound(inputRRay, 1) * UBound(inputRRay, 2)), 1 To 3)
    outRow = 0

    For inCol = 2 To UBound(inputRRay, 2)
        For inRow = 2 To UBound(inputRRay, 1)
            If inputRRay(inRow, inCol) <> vbNullString And inputRRay(inRow, inCol) <> 0 Then
                outRow = outRow + 1
                outputRRay(outRow, 1) = inputRRay(1, inCol)
                outputRRay(outRow, 2) = inputRRay(inRow, 1)
                outputRRay(outRow, 3) = inputRRay(inRow, inCol)
            End If
        Next inRow
    Next inCol
    With outputRange.Resize(1, 3)
        .EntireColumn.Clear
        .Value = Array("Store", "Product", "QTY")
        .Font.FontStyle = "Bold"
    End With
    With outputRange.Offset(1, 0).Resize(UBound(outputRRay, 1), UBound(outputRRay, 2))
        .Value = outputRRay
    End With
    With outputRange.Parent
        With Range(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
        End With
    End With
End Sub

Answer 1

如果您专门使用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

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

1 个答案: