Excelmacros – 运行在同一级别的单元格
所以我想通过A1-C200运行并将所有内容粘贴到Word文档中。 麻烦的是，我有两种方式把它粘贴到Word中，但是每一种都有它的缺陷。
目标：将A1-C200复制到Word中并保留列布局，而不复制空白。
例1：
下面的代码将所有内容复制到Word中，但是从A1 – > A200，B1 – > B200，C1 – > C200运行。 因为这样通过我的文件读取，我失去了我的列布局。 我更喜欢这个例子的解决scheme，因为这个代码看起来更清晰。
iMaxRow = 200 " Loop through columns and rows" For iCol = 1 To 3 For iRow = 1 To iMaxRow With Worksheets("GreatIdea").Cells(iRow, iCol) " Check that cell is not empty." If .Value = "" Then "Nothing in this cell." "Do nothing." Else " Copy the cell to the destination" .Copy appWD.Selection.PasteSpecial End If End With Next iRow Next iCol 例2：
下面的代码复制正确的列布局，但也插入blancs。 所以，如果填写A1-A5和A80-A90，我的Word文档中就会有75个空白。
a1 = Range("A1").End(xlDown).Address lastcell = Range("C1").Address Range(a1, lastcell).Copy With Range("A1") Range(.Cells(1, 1), .End(xlDown).Cells(2, 3)).Copy End With Range("A1:C50").Copy appWD.Selection.PasteSpecial
有很多种方法可以做到这一点，不知道哪一个是最快的，但是这里有一些代码我真的很快就投入到了你的工作中。 在一个变体中同时获取范围是从Excel中抓取数据的最快方法。
Sub test() Dim i As Long, j As Long Dim wd As Word.Document Dim wdTable As Word.Table Dim wks As Excel.Worksheet Dim v1 As Variant Set wd = GetObject("C:\Documents and Settings\Jon\Desktop\New Microsoft Word Document.doc") 'Get data in array Set wks = ActiveSheet v1 = wks.UsedRange 'Create table Set wdTable = wd.Tables.Add(Range:=wd.Application.Selection.Range, NumRows:=1, NumColumns:= _ ubound(v1,2), DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _ wdAutoFitFixed) 'Place data For i = 1 To UBound(v1) For j = 1 To UBound(v1, 2) If Len(v1(i, j)) > 0 Then 'Add row if not enough rows, this can be done before the j loop if 'you know the first column is always filled. 'You can also do an advanced filter in excel if you know that the first 'column is filled always and filter for filled cells then just 'do a straight copy and paste using r1.specialcells(xlCellTypeVisible).copy 'If you know the rows ahead of time when you create the table you can create all the rows at once, 'which should save time. wd.application.selection If wdTable.Rows.Count < i Then wdTable.Rows.Add wdTable.Cell(i, j).Range.Text = v1(i, j) End If Next j Next i Set wks = Nothing: Set wd = Nothing: Set v1 = Nothing End Sub
不太清楚我是否理解这个概念…但是这里有一个刺探：
dim rg200x3 as range: set rg200x3 = range("a1:c200") dim Col1 as new collection dim Col2 as new collection dim Col3 as new collection dim rgRow as new range dim sText as string for each rgRow in rg200x3 sText = trim(rgRow.cells(1,1)): if (sText <> "") call Col1.Add(sText) sText = trim(rgRow.cells(1,2)): if (sText <> "") call Col2.Add(sText) sText = trim(rgRow.cells(1,3)): if (sText <> "") call Col3.Add(sText) next rgRow
在这一点上，Col1，Col2和Col3包含空白单元的文本，所以现在循环打印出来
dim i as long for i = 1 to 200 on error resume next ' (cheap way to avoid checking if index > collection sz) debug.print Col1(i) + " | " Col2(i) + " | " + Col3(i) on error goto 0 next i
（注意：手写input的代码没有检查…）
这如何分解你的第一个解决scheme：
iMaxRow = 200 " Loop through columns and rows" For iRow = 1 To iMaxRow For iCol = 1 To 3 With Worksheets("GreatIdea").Cells(iRow, iCol) " Check that cell is not empty." If .Value = "" Then "Nothing in this cell." "Do nothing." Else "Copy the cell to the destination" .Copy appWD.Selection.PasteSpecial End If End With Next iCol Next iRow