借助Excel实现Word表格快速排序

news2024/11/17 1:59:29

实例需求：Word中的表格如下图所示，为了强化记忆，希望能够将表格内容随机排序，表格第一列仍然按照顺序编号，即编号不跟随表格行内容调整。

在这里插入图片描述

乱序之后的效果如下图所示（每次运行代码的结果都不一定相同）。

在这里插入图片描述

示例代码如下。

Sub SortTab()
    Dim oTab As Table, aData, sTxt As String
    Set oTab = ActiveDocument.Tables(1)
    Dim oRow As Row, oCell As Cell, iR As Long, iC As Long
    ReDim aData(1 To oTab.Rows.Count, 1 To oTab.Columns.Count)
    Randomize
    For Each oRow In oTab.Rows
        iR = iR + 1: iC = 0
        For Each oCell In oRow.Cells
            iC = iC + 1
            If iC = 1 Then
                aData(iR, iC) = Rnd() * 10000
            Else
                sTxt = oCell.Range.Text
                aData(iR, iC) = Left(sTxt, Len(sTxt) - 2)
            End If
        Next
    Next
    Dim xlApp, xlWK, xlSht
    Set xlApp = CreateObject("excel.application")
    'Set xlApp = GetObject(, "excel.application")
    xlApp.Visible = False
    Set xlWK = xlApp.workbooks.Add
    Set xlSht = xlApp.activesheet
    With xlSht.Range("A1")
        .Resize(UBound(aData), UBound(aData, 2)).Value = aData
        .currentregion.Sort key1:=.Cells(1), header:=0
        aData = .currentregion.Value
    End With
    xlWK.Close False
    xlApp.Quit
    Set xlApp = Nothing
    iR = 0
    For Each oRow In oTab.Rows
        iR = iR + 1: iC = 0
        For Each oCell In oRow.Cells
            iC = iC + 1
            If iC > 1 Then
                oCell.Range.Text = aData(iR, iC)
            End If
        Next
    Next
End Sub

【代码解析】
第3行代码获取Word文档中的第一个表格对象。
第5行代码为动态数组分配存储空间。
第6行代码初始化随机生成器。
第7~18行代码循环遍历Word表格。
第9~17行代码循环Word表格行中的全部单元格。
第12行代码对于第一列填充随机数，用于后续排序，以实现随机乱序。
第14行代码读取单元格内容。
第15行代码将文本保存到数组中。
第20行代码创建新的Excel应用，如果已经打开Excel，那么使用第21行代码获取Excel对象会更快捷。
第22行代码隐藏Excel应用程序。
第23行代码添加Excel工作簿。
第24行代码获取活动工作表。
第26行代码将数组写入到工作表。
第27行代码根据A列进行排序。
第28行代码将排序后的表格读取到数组中。
第30行代码关闭工作簿。
第31行代码关闭Excel应用程序。
第34~42行代码循环遍历Word表格，更新单元格内容，第一列序号保持不变，所有无需更新。
第39行代码将数组内容写入单元格。