Макрос 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:

Приведенный ниже код копирует правильный макет столбца,но также вставляет бланки.Поэтому, если заполнены A1-A5 и A80-A90, у меня будет 75 бланков в моем документе Word.

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

Как насчет саба для вашего первого решения:

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 2

Есть несколько способов сделать это, не знаю, какой из них самый быстрый, но вот код, который я быстро собрал для вас.Получение диапазона сразу в одном варианте - это самый быстрый способ получить данные из 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 3

не совсем уверен, что я понимаю проблему ... но вот удар:

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

(примечание: код напечатан от руки без проверки ...)