Excel宏 - 通過同一級別上的單元格運行

Question

所以我想通過A1-C200運行，並將所有內容粘貼到Word文檔中。麻煩的是，我有兩種將它粘貼到Word中的方法，但每一種都有它的缺陷。

目標：將A1-C200複製到Word中並保留列布局，而不復制空白。

實施例1：

下面拷貝到一切Word中的代碼，但是從A1運行 - > A200，B1 - > B200，C1 - > C200。因爲它以這種方式讀取我的文件，所以我失去了我的列布局。我更喜歡這個例子的解決方案，因爲這個代碼看起來更清晰。

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 

Answer 1

有多種方法可以做到這一點，不知道哪個是最快的，但這裏的一些代碼，我扔在一起真正快給你的。在變體中同時獲取範圍是從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 

Answer 2

不能肯定我理解的概率......但這裏是它刺傷：

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包含文本W¯¯分解出來的空白單元格，所以現在遍歷這些打印出來

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 

（注：在寫意類型沒有檢查代碼...）

Answer 3

如何這個給你的第一個解決方案子：

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