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

时间:2022-07-22
本文章向大家介绍常用功能加载宏——二维表转一维表,主要内容包括其使用实例、应用技巧、基本知识点总结和需要注意事项,具有一定的参考价值,需要的朋友可以参考一下。

工作中经常会碰到这种情况,外部收集来的资料,表格制作者为了排版好看,把表格做成多行多列的格式,这种格式看起来方便,但是做数据处理是非常不方便的,需要进行转换后进行数据处理:

首先在customUI.xml中增加代码:

     <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