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

taller_20002024-11-16 8:21

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

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

示例代码如下。

vb 复制代码

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行代码将数组内容写入单元格。

借助Excel完成排序只是一种实现思路，当然也可以使用其他算法对数组直接进行随机排序。