常用功能加载宏——二维表转一维表

     <menu id="rbmenuTrans" label="表格转换&#13;" size="large" imageMso="TableSummarizeWithPivot">
      <button id="rbbtnTarnsTable2To1" label="二维表转一维表" onAction="rbbtnTarnsTable2To1" supertip="将选择的多行多列表格转换为多行3列表格。"/>
     </menu>

Sub rbbtnTarnsTable2To1(control As IRibbonControl)
    Call MShtWk.TarnsTable2To1
End Sub

Sub TarnsTable2To1()
    If VBA.TypeName(Selection) <> "Range" Then
        Exit Sub
    End If
    
    Dim rngSrc As Range, rngDes As Range
    Set rngSrc = Selection
    If rngSrc.Cells.Count < 4 Then
        MsgBox "转换至少需要2行2列的数据！"
        Exit Sub
    End If
    
    On Error Resume Next
    Set rngDes = Application.InputBox("请选择输出单元格。", Default:=rngSrc.Range("A1").Offset(rngSrc.rows.Count + 1, 0).Address, Type:=8)
    On Error GoTo 0
    
    If rngDes Is Nothing Then Exit Sub
    Set rngDes = rngDes.Range("A1")
    
    Dim arr(), Result() As Variant
    arr = rngSrc.Value
    Dim iRows As Long, iCols As Long
    Dim i As Long, j As Long
    
    iRows = rngSrc.rows.Count - 1
    iCols = rngSrc.Columns.Count - 1
    ReDim Result(1 To iRows * iCols + 1, 1 To 3) As Variant
    
    Dim pRow As Long
    pRow = 1
    Result(pRow, 1) = "行标题"
    Result(pRow, 2) = "列标题"
    Result(pRow, 3) = "数据"
    For i = 2 To iRows + 1
        For j = 2 To iCols + 1
            pRow = (i - 2) * iCols + j - 1 + 1
            Result(pRow, 1) = "'" & arr(i, 1)
            Result(pRow, 2) = "'" & arr(1, j)
            Result(pRow, 3) = arr(i, j)
        Next j
    Next i
    
    rngDes.Resize(iRows * iCols + 1, 3).Value = Result
End Sub