如何將格式化的文本從excel複製到使用vba的單詞更快

Question

問題： 我想使用excelvba腳本將excel中的格式文本複製到單詞中。 腳本盡職盡責地複製信息，但速度太慢。

你能給我提示如何加快速度嗎？

我的方法到目前爲止都記錄在這個虛擬文檔中。 該腳本假定單元格C1：C100包含格式化的文本。

一般信息。 我正在寫excelvba makro，將格式化文本塊複製到word文檔。 對於每個文本塊有兩個版本。宏跟蹤文字樣式（刪除：textcolor紅色和刪除線等） 的變化，並將結果複製到第三個列。 這部分工作就像一個魅力。然後第三列被複制到一個word文檔。 這部分工作在我的機器上（i7-3770，ssd，8 Gb Ram），但不在可憐的靈魂機器上，他必須使用腳本（amd Athlon 220） 生產尺寸爲700-1000個文本塊，每個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