Question

我正在尝试使用VBA将表从一种格式转换为另一种格式：

（当前原始表为（17行乘以17000列）定期添加列，并且可以添加或删除行，因此它必须是动态的）

表格示例：

我编写了一个适用于小型示例的代码，但是它炸开了较大的代码集，由于无法正常工作，我不得不将代码分成两部分，我相信它可以做得更好

我修改了一个在网上找到的示例，但是该示例是针对类似的问题，并非相同

    Dim Rng As Range
    Dim cRng As Range
    Dim rRng As Range
    Dim xOutRng As Range
    xTitleId = "KutoolsforExcel"
    Set cRng = Application.InputBox("Select Code Column", xTitleId, Type:=8)
    Set rRng = Application.InputBox("Select Row from Code to last SKU", xTitleId, Type:=8)
    Set Rng = Application.InputBox("Select your data", xTitleId, Type:=8)
    Set outRng = Application.InputBox("Select cell A2 on next sheet", xTitleId, Type:=8)
    Set xWs = Rng.Worksheet

    Dim Rng2 As Range
    Dim cRng2 As Range
    Dim rRng2 As Range
    xTitleId = "KutoolsforExcel"
    Set cRng2 = Application.InputBox("Select Date Column", xTitleId, Type:=8)
    Set rRng2 = Application.InputBox("Select Row from date to last SKU", xTitleId, Type:=8)
    Set Rng2 = Application.InputBox("Select your data", xTitleId, Type:=8)

    'Section 1
    k = 1
    xColumns = rRng.Column
    xRow = cRng.Row
    For i = Rng.Rows(1).Row To Rng.Rows(1).Row + Rng.Rows.Count - 1
        For j = Rng.Columns(1).Column To Rng.Columns(1).Column + Rng.Columns.Count - 1
            outRng.Cells(k, 2) = xWs.Cells(i, xColumns)
            outRng.Cells(k, 3) = xWs.Cells(xRow, j)
            outRng.Cells(k, 4) = xWs.Cells(i, j)
            k = k + 1
        Next j
    Next i

    'Section 2
    k = 1
    xColumns2 = rRng2.Column
    For i = Rng.Rows(1).Row To Rng.Rows(1).Row + Rng.Rows.Count - 1
        For j = Rng.Columns(1).Column To Rng.Columns(1).Column + Rng.Columns.Count - 1
            outRng.Cells(k, 1) = xWs.Cells(i, xColumns2)
            k = k + 1
        Next j
    Next i
    End Sub

Answer 1

如果您仍在寻找vba解决方案，可以将其作为一个概念：

Option Explicit

Public Sub CopyTable()

    Dim rngValues As Range
    Dim rngValueColumns As Range
    Dim rngTarget As Range

    Dim varCell As Variant
    Dim varColumn As Variant
    Dim intNumberOfRows As Integer
    Dim intRowCounter As Integer
    Dim arrTarget() As Variant


    With ThisWorkbook.Worksheets("ExampleTable")
        ' 1. Define value range (You will have to adjust this to your value range)
        Set rngValues = Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))


        ' 2. Get all value columns
        Set rngValueColumns = Range(.Cells(1, 3), .Cells(1, Columns.Count).End(xlToLeft))
    End With

    ' 3. Dimension target array. Should number of rows * number of value columns to 3 columns
    intNumberOfRows = rngValues.Rows.Count * rngValueColumns.Columns.Count

    ReDim arrTarget(1 To intNumberOfRows, 1 To 3)

    ' 3. Build an array of your target table in memory. Loop over each extra column and add rows.
    intRowCounter = 1
    For Each varColumn In rngValueColumns
        For Each varCell In rngValues
            arrTarget(intRowCounter, 1) = varCell.Value
            arrTarget(intRowCounter, 2) = varCell.Offset(0, 1).Value
            arrTarget(intRowCounter, 3) = varCell.Offset(0, varColumn.Column - 1).Value
            intRowCounter = intRowCounter + 1
        Next varCell
    Next varColumn

    ' 4. Define target range
    With ThisWorkbook.Worksheets("ExampleTable2")
        Set rngTarget = .Range(.Cells(1, 1), .Cells(UBound(arrTarget, 1), UBound(arrTarget, 2)))
        rngTarget = arrTarget
    End With

End Sub

Excel-将表格转换成其他格式

1 个答案: