用VBA在Word中随机打乱单词表,进行分列

一、效果展示(以下是三次随机打乱的结果)

二、代码

vbscript 复制代码
Sub 随机分单词到后面的单元格()
    Dim C1 As Cell
    Dim str, str1, a
    Dim shuffledArray() As Variant
    Set C1 = Selection.Range.Tables(1).Cell(1, 1)
    str = C1.Range.text
    str = mid(str, 3, Len(str) - 4)
    str1 = Split(str, vbCr)
    
        ' 获取数组大小
    arraySize = UBound(str1) - LBound(str1) + 1
    halfSize = arraySize \ 2
    
    ' 生成一个打乱的数组
    ReDim shuffledArray(LBound(str1) To UBound(str1))
    For i = LBound(str1) To UBound(str1)
        shuffledArray(i) = str1(i)
    Next i
    
    ' 打乱数组
    Call 随机打乱数组(shuffledArray)
    
    ' 分配到两个新数组
    ReDim group1(LBound(shuffledArray) To halfSize - 1)
    ReDim group2(halfSize To UBound(shuffledArray))
    
    For i = LBound(shuffledArray) To UBound(shuffledArray)
        If i < halfSize Then
            group1(i) = shuffledArray(i)
        Else
            group2(i) = shuffledArray(i)
        End If
    Next i
    
    ' 输出结果
    For Each a In group1
        str2 = str2 & a & vbCr
    Next
    For Each a In group2
        str3 = str3 & a & vbCr
    Next
    Selection.Range.Tables(1).Cell(1, 2).Range.text = str2
    Selection.Range.Tables(1).Cell(1, 3).Range.text = str3

End Sub

Sub 随机打乱数组(ByRef arr() As Variant)
    Dim i As Integer
    Dim j As Integer
    Dim temp As Variant
    Dim n As Integer
    
    n = UBound(arr) - LBound(arr) + 1
    
    For i = LBound(arr) To UBound(arr)
        j = Int((UBound(arr) - LBound(arr) + 1) * Rnd + LBound(arr))
        temp = arr(i)
        arr(i) = arr(j)
        arr(j) = temp
    Next i
End Sub
相关推荐
yivifu14 小时前
使用VBA区分简体中文段落和繁体中文段落的方法
word·excel·vba
骆驼爱记录1 天前
Word三线表制作全攻略
自动化·word·wps·新人首发
盘古工具2 天前
告别重复劳动:Word 重复上一次操作的两种方法
windows·word
好名字08213 天前
Vue2转Word方法(html-docx-js库)
javascript·html·word
檐下翻书1733 天前
企业组织架构图导出Word 在线编辑免费工具
人工智能·信息可视化·去中心化·word·流程图·ai编程
涛涛北京3 天前
【word】- 宏操作 - 如何在word中插入宏
word
涛涛北京3 天前
【word】- 宏操作 - 如何在word中批量修改图片格式
word
usdoc文档预览3 天前
Word文件转PDF、WPS在线打印、js提取Word文件内容、轻松将Word文档转为PDF
pdf·word·wps·在线预览·word转pdf·在线编辑·ofd在线预览解析
身如柳絮随风扬3 天前
Spring Boot文档导出(Word,Excel,PPT),导入(Excel)
spring boot·word·excel·ppt
赵丙双3 天前
python-docx 报错 KeyError: “There is no item named ‘NULL‘ in the archive“
python·word·docx·python-docx