用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
相关推荐
DS随心转APP2 小时前
AI导出鸭插件 如何解决这些痛点,以及它如何重构“批量导出”这件事,让 纳米AI导出Excel 和其他格式告别手动整理,让AI导出回归优雅。
人工智能·重构·word·excel·deepseek·ai导出鸭
ThsPool2 小时前
从 Word 数据标准中自动提取字段表:一套可配置的 Markdown 整理方案
word
lskblog2 小时前
Ubuntu 18.04 安装 LibreOffice(用于 Word 在线预览转换)
java·linux·python·ubuntu·word·php·laravel
show4331 天前
2026多格式导出技术方案:小程序端免费TXT/Word/SRT生成实践
小程序·word
DS随心转APP2 天前
实测 AI 导出鸭实操效果,依托 AI 直接生成 word 功能横向比对五类导出办法,梳理办公文档转换最优路径
人工智能·ai·word·deepseek·ai导出鸭
AI英德西牛仔3 天前
秘塔 导出word指令之外:AI导出鸭电脑版的底层逻辑与批量交付哲学
人工智能·word·excel·deepseek·ai导出鸭
2601_963906783 天前
[特殊字符] DocxTableExport:一键提取 Word 文档中的表格数据
word·软件需求
yivifu3 天前
解决word文档中行尾中文破折号被分断的问题
word
wujian83113 天前
豆包导出word手机,就用AI导出鸭:一站式批量导出方案深度解析
人工智能·ai·chatgpt·智能手机·word·ai导出鸭