动态重新格式化 Excel 工作表答案

【问题标题】：Dynamically reformatting an excel sheet动态重新格式化 Excel 工作表
【发布时间】：2015-12-15 00:51:20
【问题描述】：

我有一个非常凌乱的 Excel 表格，我正在尝试将其重新格式化为可读的内容。目前，它的结构是这样的（每个大的分隔都类似于一个新的单元格）：

Title1    Var1   Var1_Value    Var1.1    Var1.1_Value ... Var1.K Var1.K_Value
Title2    Var2   Var2_Value   Var2.1    Var2.1_Value ... Var2.L  Var2.L_Value
...
TitleM    VarM   VarM_Value   VarM.1    VarM.1_Value ... VarM.N  VarM.N_Value

为了澄清，每行的变量和值的数量各不相同，但是每个变量都有一个值。最终，我的最终目标是创建如下格式的内容：

Title1    Var1    Var1_Value
Title1    Var1.1  Var1.1_Value
...
TitleM    VarM.N  VarM.N_Value

标题字符串针对其行中的每个 Var 和 Var_Value 重复。

我对 VBA 了解不多，因此我正在寻求有关实现此格式的最佳途径的帮助。这是我在下面的伪代码中的思考过程，我尽可能将其格式化为 VBA 风格。

for idx = 1 To lastRow
      ' Will likely have to create a function to find 
      ' last filled column in a row -- lastColForRow
      tempArray = data(idx,2 To lastColforRow(idx))
      for jdx = 1 To length(tempArray)-1 Step 2
          newCell(end+1,1) = data(idx,1)
          newCell(end+1,2) = tempArray(j)
          newCell(end+1,3) = tempArray(j+1)
      next  jdx
next idx

【问题讨论】：

标签： excel vba

【解决方案1】：

这段代码应该这样做（注意它假定没有标题行）

Public Sub Reformat()
Dim lastrow As Long
Dim lastcol As Long
Dim numrows As Long
Dim i As Long, ii As Long

    Application.ScreenUpdating = False

    With ActiveSheet

        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = lastrow To 1 Step -1

            lastcol = .Cells(i, .Columns.Count).End(xlToLeft).Column
            'integer division so as to get the number of value pairs
            numrows = lastcol \ 2
            'only do anything if we have more than one value pair
            If numrows > 1 Then

                'insert extra rows for extra value pairs
                .Rows(i + 1).Resize(numrows - 1).Insert
                'copy the titles down to all new rows
                .Cells(i, "A").Copy .Cells(i, "A").Resize(numrows)
                'a value pair at a time, cut and copy to next new row
                For ii = 4 To lastcol Step 2

                    'target row is current row (i) + the value pair index ((ii /2)-1)
                    .Cells(i, ii).Resize(, 2).Cut .Cells(i + (ii / 2) - 1, "B")
                Next ii
            End If
        Next i
    End With

    Application.ScreenUpdating = True
End Sub

【讨论】：

谢谢，鲍勃！乍一看，它似乎可以完成这项工作——我将对此进行深入研究以了解发生了什么。
我添加了一些 cmets 来帮助您理解这一点

【解决方案2】：

这会将数组放到新的工作表上

Sub climatefreak()
Dim lastrow&
Dim ws As Worksheet
Dim lastcolumn&
Dim idx&
Dim ClmIdx&
Dim tws As Worksheet
Dim i&
Dim trw&


Set tws = Sheets("Sheet3")
Set ws = ActiveSheet

With ws
    lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row

    For idx = 1 To lastrow
        Dim temparr
        lastcolumn = .Cells(idx, .Columns.Count).End(xlToLeft).Column
        temparr = Range(.Cells(idx, 1), .Cells(idx, lastcolumn)).Value
        For i = LBound(temparr, 2) + 1 To UBound(temparr, 2) Step 2
            trw = tws.Range("A" & tws.Rows.Count).End(xlUp).Row + 1
            tws.Cells(trw, 1) = temparr(UBound(temparr, 1), 1)
            tws.Cells(trw, 2).Resize(, 2) = Array(temparr(1, i), temparr(1, i + 1))
        Next i
    Next idx
End With



End Sub

【讨论】：