Question

所以我想通过A1-C200运行并将所有内容粘贴到Word文档中。麻烦的是，我有两种方法将它粘贴到Word中，但每一种都有它的垮台。

目标：将A1-C200复制到Word中并保留列布局，而不复制空白。

示例1：

下面的代码将所有内容复制到Word中，但是从A1运行 - ＆gt; A200，B1 - ＆gt; B200，C1 - ＆gt; 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

不太确定我理解这个问题......但是这里有一个问题：

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 2

如何为您的第一个解决方案提供支持：

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

Answer 3

有多种方法可以做到这一点，不知道哪个是最快的，但是这里有一些代码我真的很快就为你准备了。在变体中同时获取范围是从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

Excel宏 - 在同一级别上运行单元格

3 个答案: