如何创建一个循环，以便如果表中的单元格包含字符，它将自动创建另一行单元格

Question

该表在MS WORD中，但我正在尝试使用VBA来循环它。目前，我有从源中提取的数据，并希望在MS word的表格中输入。该表包含多行和 2 列。数据将在每行的第二列内输入。现在，我有很多数据，我不可能继续指定每个行号，因此我想找到一种方法在填充单元格时添加额外的行。

在Excel中，这组代码可以工作，但在word中不起作用。

Do While (Len(Worksheets("Overall Performance").Cells(NewRecordRow, 12).Value) <> 0)
NewRecordRow = NewRecordRow + 1
Loop

目前这就是我所拥有的。

Dim intNoOfRows
Dim intNoOfColumns
Dim objWord
Dim objDoc
Dim objRange
Dim objTable
intNoOfRows = 1 (Initially 6 because I Preset it)
intNoOfColumns = 2
Set objWord = CreateObject ("Word.Application")
Set objDoc = objWord.Document.Add
objDoc.Tables.Add objRange, intNoOfRows, intNoOfColumns
Set objTable = objDoc.Tables(1)
objTable.Borders.Enable = True
For Each cell(intNoOfRows,2) in objDoc.Table(1).range.cells
If Len(cell.range.text) <1 Then
intNoOfRows = intNoOfRows + 1
End if
Next
ObjTable.Cell(intNoOfRows,2).Range.Text = "ABC"

Answer 1

根据我的测试，以下代码在我这边运行良好(关键点是 InStr( [开始]， 字符串，子字符串， [比较] ((。

Do While InStr(1, strCellText, "", vbBinaryCompare) <> 1
'MsgBox "OK"
Selection.InsertRowsBelow 1
Loop

工作完整代码(出于测试目的，请先手动创建一个包含 N 行和三列的表(：

Sub Test()
Dim intNoOfRows
Dim intNoOfColumns
Dim objWord
Dim objDoc
Dim objRange
Dim objTable As Word.Table
Dim strCellText As String
intNoOfRows = 1 '(Need to be the actully row count of your talbe)
intNoOfColumns = 3
Set objDoc = ActiveDocument
Set objTable = objDoc.Tables(1)
objTable.Borders.Enable = True
With objTable  
strCellText = .Cell(intNoOfRow, 2).Range.Text
intNoOfRows = .Rows.Count
Do While InStr(1, strCellText, "", vbBinaryCompare) <> 1
'MsgBox "OK"
intNoOfRows = intNoOfRows + 1
Loop      
.Rows.Last.Select
Selection.InsertRowsBelow 1
.Cell(intNoOfRows, 3).Range.Text = "ABC"
MsgBox intNoOfRows
End With
End Sub

您也可以使用以下代码，但这会遇到内存问题，因此不建议这样做：

With objTable
Do While Len(.Cell(intNoOfRows, 2).Range.Text) <> 0
intNoOfRows = intNoOfRows + 1
MsgBox intNoOfRows
Loop
End With