如何从excel复制格式化文本到使用vba更快的词

问题：我想用excelvba脚本将excel格式的文本复制到word中。 该剧本尽职尽责，但速度太慢。

你能给我一个提示如何加快速度吗？

到目前为止，我的方法是在这个虚拟文档中logging的。 该脚本假定单元格C1：C100包含格式文本。

一般信息。 我正在写excelvba makro，将文本块复制到word文档。 对于每个文本块有两个版本。 macros跟踪改变文字样式（删除：textcolor红色和删除线等），并将结果复制到第三个列。 这部分工作就像一个魅力。 然后第三列被复制到一个word文档。 这部分工作在我的机器上（i7-3770，ssd，8 Gb Ram），但是不能在可怜的灵魂机器上使用脚本（amd Athlon 220），生产规模是700-1000个文本块，有100-1000个字符每。

option explicit Sub start() Dim wapp As Word.Application Dim wdoc As Word.Document Set wapp = CreateObject("word.application") wapp.Visible = False Application.ScreenUpdating = False Set wdoc = wapp.Documents.Add 'Call copyFormattedCellsToWord(wdoc) 'Call copyFormattedCellsToWordForEach(wdoc) 'Call copyWholeRange(wdoc) Call concatenateEverythingInAStringAndCopy(wdoc) wapp.Visible = True End Sub 'desired output-result (every cell in a new line and formatting preserved) meets the specs, but to slow Sub copyFormattedCellsToWord(wdoc As Word.Document) Dim counter As Long Worksheets(1).Select For counter = 1 To 100 Worksheets(1).Range("C" & counter).Copy wdoc.Range(wdoc.Range.End - 1, wdoc.Range.End).PasteSpecial Placement:=wdInLine, DataType:=wdPasteHTML Next counter End Sub 'desired output-result, a tiny bit faster (might be only superstition), but still not fast enough Sub copyFormattedCellsToWordForEach(wdoc As Word.Document) Dim cell As Range Worksheets(1).Select For Each cell In Worksheets(1).Range("C1:C100") cell.Copy wdoc.Range(wdoc.Range.End - 1, wdoc.Range.End).PasteSpecial Placement:=wdInLine, DataType:=wdPasteHTML Next cell End Sub 'fast enough, but introduces a table in the word document and therefore 'doesn't meet the specs Sub copyWholeRange(wdoc As Word.Document) Worksheets(1).Range("C1:C100").Copy wdoc.Range(wdoc.Range.End - 1, wdoc.Range.End).PasteSpecial Placement:=wdInLine, DataType:=wdPasteHTML End Sub 'fast enought, looses the formatting Sub concatenateEverythingInAStringAndCopy(wdoc As Word.Document) Dim wastebin As String Dim cell As Range wastebin = "" Worksheets(1).Select For Each cell In Worksheets(1).Range("C1:C100") wastebin = wastebin & cell.Value Next cell Range("D1") = wastebin Range("D1").Copy wdoc.Range(wdoc.Range.End - 1, wdoc.Range.End).PasteSpecial Placement:=wdInLine, DataType:=wdPasteHTML End Sub 

Answer 1

用这种方法修改你的copyWholeRange方法：

 Sub copyWholeRange(wdoc As Word.Document) Worksheets(1).Range("C1:C10").Copy wdoc.Range(wdoc.Range.End - 1, wdoc.Range.End).PasteSpecial Placement:=wdInLine, DataType:=wdPasteHTML wdoc.Tables(1).ConvertToText Separator:=wdSeparateByParagraphs End Sub