我有一个字符串数组（大约15000,2），下面的代码将这些字符串写到Word文档中。我写到文档中的数组越“行”，代码就会变得越来越慢。对于（1000,2）的数组需要大约4分钟，大约（2000,2）个数组。需要20分钟。我的问题是我不知道如何使代码更快。
屏幕更新已关闭。
'Go through every "row" of the array arrDatenGefiltert
For RowIndex = 0 To lngRowIndex_arrDatenGefiltert
'If the value of the array at the actual "row" and first "column" is not empty...
If Not arrDatenGefiltert(lngRowIndex_arrDatenGefiltert, 0) = "" Then
'Write the content of the actual "row" of the array in the document
With ThisDocument
'Write the content of the actual "row" and the first "column" in the document
With .Paragraphs(.Paragraphs.Count).Range
.Text = arrDatenGefiltert(RowIndex, 0)
''Some formatting
.Font.Size = 11
.Font.Bold = False
End With
'New Paragraph at the end of the document
.Paragraphs.Add
'If the second "column" entry is not empty
If Not arrDatenGefiltert(RowIndex, 1) = "" Then
'Write the content of the actual "row" and the second "column" in the document
With .Paragraphs(.Paragraphs.Count).Range
.Text = arrDatenGefiltert(RowIndex, 1)
'Some formatting
.Font.Size = 12
.Font.Bold = True
End With
'New Paragraph at the end of the document
.Paragraphs.Add
End If
''Write the content of the actual "row" and the thrid "column" in the document
With .Paragraphs(.Paragraphs.Count).Range
.Text = arrDatenGefiltert(RowIndex, 2)
'Some formatting
.Font.Size = 12
.Font.Bold = False
End With
'New paragraph at the end of the document
.Paragraphs.Add
'Write an additional line at the end of the document (which is the same for every "row" of the array)
With .Paragraphs(.Paragraphs.Count).Range
.Text = "*****************"
'Some formatting
.Font.Size = 12
.Font.Bold = False
End With
'New paragraph at the end of the document
.Paragraphs.Add
End With
End If
Next RowIndex
'Some formatting for the whole document
ThisDocument.Range(0, 0).Select
Selection.WholeStory
With Selection
.Font.Color = wdColorBlack
.Font.Italic = False
.Font.Name = "Calibri"
.Font.Underline = wdUnderlineNone
.ParagraphFormat.Alignment = wdAlignParagraphLeft
End With
答案 0 :(得分：0)
我看到了一些帮助解决问题的方法，只需浏览一下代码即可：
.Paragraphs(.Paragraphs.Count).Range-会导致每个.的性能下降，而是创建一个Range对象并对其进行处理。例如：
Dim rngEndOfDoc as Word.Range
Set rngEndOfDoc = ActiveDocument.Content
rngEndOfDoc.Collapse wdCollapseEnd
'Add new content here
rngEndOfDoc.Text = "something"
'Collapse it each time new content should be added with different formatting
rngEndOfDoc.Collapse wdCollapseEnd
Paragraphs.Add添加新段落。而是使用vbCr将新段落连接到字符串中。例如：
arrDatenGefiltert(RowIndex, 1) & vbCr & arrDatenGefiltert(RowIndex, 2)
ThisDocument。相反，请使用ActiveDocument，或者甚至更好的方法是声明并实例化Document对象（并使用 会更快）。示例：
Dim doc as Word.Document
Set doc = ActiveDocument
With doc
答案 1 :(得分：0)
这是我的调整后代码，其中包含Cindy Meister的建议。我进一步走了一步，将整个文本写成字符串，包括“ -signs”段，然后从那里写到Word文档中。我之后所做的格式化：
'''Write the whole content from the strings in the array arrDatenGefiltert in the string strContent
'For each "row" of the array
For RowIndex = 0 To lngRowIndex_arrDatenGefiltert
'If the first "column" of the array is not empty
If Not arrDatenGefiltert(lngRowIndex_arrDatenGefiltert, 0) = "" Then
'Write the first "column" of the actual "row" of the array in the string; before, add some unique characters
strContent = strContent & "%$!First!" & arrDatenGefiltert(RowIndex, 0) & vbCr
'If the second "column" of the actual "row" of the array is not empty
If Not arrDatenGefiltert(RowIndex, 1) = "" Then
'Write the second "column" of the actual "row" of the array in the string; before, add also some unique characters
strContent = strContent & "%$!Second!" & arrDatenGefiltert(RowIndex, 1) & vbCr
End If
'Write the third "column" of the actual "row" of the array in the string; before, add also some unique characters
strContent = strContent & "%$!Thrid!" & arrDatenGefiltert(RowIndex, 2) & vbCr
''Write an additional line
strContent = strContent & "*****************" & vbCr
End If
Next RowIndex
'''Write the value of the string strContent in the Word document
ActiveDocument.Range(0, 0).Text = strContent
这里是定义样式的示例；我定义了其中三个。其他两个与此非常相似：
Sub DefineStyleFirst()
WordBasic.FormatStyle Name:="StyleFirst", NewName:="", BasedOn:="", NextStyle:="", Type:=0, FileName:="", link:=""
WordBasic.FormatStyle Name:="StyleFirst", NewName:="", BasedOn:="", NextStyle:="", Type:=0, FileName:="", link:=""
With ActiveDocument.Styles("StyleFirst").Font
.Name = "Calibri"
.Size = 11
.Bold = False
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Scaling = 100
.Kerning = 0
.Animation = wdAnimationNone
End With
With ActiveDocument.Styles("StyleFirst").ParagraphFormat
.LeftIndent = CentimetersToPoints(0)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 10
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceMultiple
.LineSpacing = LinesToPoints(1.15)
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(0)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
.MirrorIndents = False
.TextboxTightWrap = wdTightNone
End With
ActiveDocument.Styles("StyleFirst").NoSpaceBetweenParagraphsOfSameStyle = False
ActiveDocument.Styles("StyleFirst").ParagraphFormat.TabStops.ClearAll
With ActiveDocument.Styles("StyleFirst").ParagraphFormat
With .Shading
.Texture = wdTextureNone
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = wdColorAutomatic
End With
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
With .Borders
.DistanceFromTop = 1
.DistanceFromLeft = 4
.DistanceFromBottom = 1
.DistanceFromRight = 4
.Shadow = False
End With
End With
ActiveDocument.Styles("StyleFirst").NoProofing = False
ActiveDocument.Styles("StyleFirst").Frame.Delete
End Sub
只需要像这样调用代码；在字符串strContent的填充之后：
DefineStyleFirst
DefineStyleSecond
DefineStyleThird
所有这些步骤之后，最终将文本格式化：
'For each element of the collection "Paragraphs"
For Each Element In ActiveDocument.Paragraphs
'If the first characters of the paragraph are "%$!First!"
If Left(Element.Range.Text, 9) = "%$!First!" Then
'The Style of the paragraph is set to "StyleFirst"
Element.Style = "StyleFirst"
'Delete the first characters of the paragraph
Element.Range.Text = Right(Element.Range.Text, Len(Element.Range.Text) - 9)
End If
'If the first characters of the paragraph are "%$!Second!"
If Left(Element.Range.Text, 10) = "%$!Second!" Then
'The Style of the paragraph is set to "StyleSecond"
Element.Style = "StyleSecond"
'Delete the first characters of the paragraph
Element.Range.Text = Right(Element.Range.Text, Len(Element.Range.Text) - 10)
End If
'If the first characters of the paragraph are "%$!Third!"
If Left(Element.Range.Text, 9) = "%$!Third!" Then
'The Style of the paragraph is set to "StyleThird"
Element.Style = "StyleThird"
'Delete the first characters of the paragraph
Element.Range.Text = Right(Element.Range.Text, Len(Element.Range.Text) - 9)
End If
'If the first characters of the paragraph are "*****************"
If Left(Element.Range.Text, 17) = "*****************" Then
'The Style of the paragraph is set to "StyleThird"
Element.Style = "StyleThird"
End If
Next Element