新人初学，word宏修改字体用，一次大概10w个字左右，运行最快都要10分钟，最慢就直接卡死，请大佬不吝赐教

2021-03-15 12:33:53 566 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

Python自动化办公：定制化读取Excel数据并写入Word表格在数据处理与文档生成的工作流中，自动化技术正逐步取代传统的手动操作。其核心原理是通过编程脚本，实现对结构化数据的精准提取、转换与格式化输出，从而将人力从重复性劳动中解放出来。这项技术的价值在于显著提升工作效率、减少人为错误，并确保输出结果的一致性。它广泛应用于报告生成、数据汇总、信息归档等需要跨软件协作的场景。针对常见的性能瓶颈与样式控制难题，例如“python读取excel数据全部读取耗时5分钟”和“poi设置word表格单元格宽度”，本文将通过Python生态中的主流库，构建一个健壮、高效的定制化数据流阅读详情

Sub 随机模仿手写()

Dim Ra As Range
Dim FontSize() As String
FontSize = Split("16.5,16.5,17,18", ",")
Dim FontName() As String
FontName = Split("A1,A2,A3,A4,A5", ",")
a = 0
'a值调整字体上下的偏差
b = 1
'b值调整字间距
'c = 20
'c值调整行间距
For Each Ra In ActiveDocument.Characters
VBA.Randomize
FontNameLength = UBound(FontName) - LBound(FontName)
FontSizeLength = UBound(FontSize) - LBound(FontSize)
Ra.Font.Name = FontName(Int(VBA.Rnd * FontNameLength) + 1)
Ra.Font.Size = FontSize(Int(VBA.Rnd * FontSizeLength) + 1)
Ra.Font.Position = Choose(Int(VBA.Rnd * 0.5) + 1, -1, -0.5, 0, 0.5, 1) + a
Ra.Font.Spacing = Choose(Int(VBA.Rnd * 1) + 1, -1.5, -1, -0.5, 0, 0.5, 1, 2) + b
If Ra = "。" Or Ra = "，" Or Ra = "；" Or Ra = "’" Or Ra = "‘" Or Ra = "“" Or Ra = "”" Or Ra = "！" Or Ra = "：" Then
'Ra.Font.Name = "A1"
Ra.Font.Size = "14"
Ra.Font.Position = "-0.5"
Ra.Font.Spacing = "-1"
'ElseIf Asc(Ra) >= 48 And Asc(Ra) <= 57 Then
' Ra.Font.Name = "J2,J3,J4"
ElseIf Asc(Ra) >= 97 And Asc(Ra) <= 122 Or Asc(Ra) >= 65 And Asc(Ra) <= 90 Or Ra = " . " Or Ra = "（" Or Ra = "）" Or Ra = "(" Or Ra = ")" Or Ra = "～" Then
'Ra.Font.Name = "J1,J2,J3,J4,J5,A1,A2,A3"
End If
If Ra = "." Or Ra = "状" Then
Ra.Font.Name = "A3"
Ra.Font.Size = "16.5"
Ra.Font.Position = "0"
Ra.Font.Spacing = "0"
End If
If Ra = "，" Or Ra = "、" Then
Ra.Font.Name = "A3"
Ra.Font.Size = "16.5"
Ra.Font.Position = "0"
Ra.Font.Spacing = "-5"
End If
If Ra = "0" Or Ra = "、" Then
Ra.Font.Size = "11"
Ra.Font.Position = "0"
Ra.Font.Spacing = "0"
End If
If Ra = "顶" Then
Ra.Font.Name = "W3"
Ra.Font.Size = "16.5"
Ra.Font.Position = "0"
Ra.Font.Spacing = "0"
End If
Next

'For Each Ra In ActiveDocument.Paragraphs

' Ra.ParagraphStyle.LineSpacingRule = wdLineSpaceExactly
' Ra.ParagraphStyle.LineSpacing = Int(VBA.Rnd * 1) + 1 + c
' Next

'With Selection.ParagraphFormat
' .FirstLineIndent = CentimetersToPoints(0.35)
' .CharacterUnitFirstLineIndent = 0
' End With

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "“"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute2007 Replace:=ReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "”"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Application.ScreenUpdating = False
End Sub

...全文