如何使用 word vba 拆分 Microsoft Word table 中所有垂直合并的单元格?
How to split all the vertically merged cells in Microsoft Word table using word vba?
我有一个词table,其中包含无数垂直合并。
我需要将所有合并的单元格拆分为具有合并单元格中先前值的单个单元格。
我搜索了很多参考资料,但找不到任何其他更短的方法来拆分 Word 中 Table 单元格中的所有垂直合并。
此函数将取 word 中的第一个 table,并将删除 MS Word 中 table 的所有单元格的所有垂直合并。
Function SplitVerticalMerge()
'Created by Chandraprakash [Yoh]
Dim i As Long, j As Long, k As Long, cols As Long, m As Long
Dim sData() As Variant
Dim oTable As Table
Dim oCell As Cell
Dim oRng As Range
Dim sText As String
Dim sRow As String
Dim iRow As Long
'Rows of Merged and NonMerged cells in Table
Dim oColl1 As New Collection
'Row with number of merged cells in Table (Vertical Split Number)
Dim oColl2 As New Collection
Set oTable = ActiveDocument.Tables(1)
With oTable
'Load all the Table cell index
ReDim sData(1 To .Rows.Count, 1 To .Columns.Count)
Set oCell = .Cell(1, 1)
Do While Not oCell Is Nothing
sData(oCell.RowIndex, oCell.ColumnIndex) = oCell.RowIndex & "," & oCell.ColumnIndex
Set oCell = oCell.Next
Loop
'1. Mark the merged cell as "X"
'2. Mark the non merged cell as "A"
'3. Load the result for each row to Collection1
For i = 1 To UBound(sData)
sRow = ""
For j = 1 To UBound(sData, 2)
sRow = sRow & IIf(IsEmpty(sData(i, j)), "X", "A") ' & "|"
Next j
oColl1.Add sRow
Next i
For cols = 1 To oTable.Columns.Count
'Load one by one Row with number of merged cells in Table (Vertical Split Number)
Set oColl2 = Nothing
j = 1
For i = oColl1.Count To 1 Step -1
'"X" - Merged
If Mid(oColl1(i), cols, 1) = "X" Then
j = j + 1
k = j
'"A" - NotMerged
Else
k = j
j = 1
End If
If j = 1 Then oColl2.Add k
Next i
iRow = oTable.Columns(cols).Cells.Count
k = iRow
For j = 1 To oColl2.Count
For i = oColl2.Count To 1 Step -iRow
'cols - Column Number
'k - cell row number in column (cols)
'j - Split number for the cell (k)
'Split the cell by above attributes defined
oTable.Columns(cols).Cells(k).Split oColl2(j), 1
'1. Enter if merged cell is split (j>1)
'2. Will fill the values for split empty cell with previous merged cell value
If oColl2(j) > 1 Then
For m = 1 To oColl2(j) - 1
oTable.Columns(cols).Cells(k + m).Range.Text = oTable.Columns(cols).Cells(k).Range.Text
Next m
End If
k = k - 1
Next i
Next j
Next cols
'To avoid application freezing
DoEvents
End With
lbl_Exit:
Set oColl1 = Nothing
Set oColl2 = Nothing
Set oTable = Nothing
Set oCell = Nothing
Set oRng = Nothing
Exit Function
End Function
参考: Graham Mayor 的基本代码 - MS MVP (Word)
URL: http://www.vbaexpress.com/forum/showthread.php?59760-Unmerging-Vertically-merged-cells
我有一个词table,其中包含无数垂直合并。
我需要将所有合并的单元格拆分为具有合并单元格中先前值的单个单元格。
我搜索了很多参考资料,但找不到任何其他更短的方法来拆分 Word 中 Table 单元格中的所有垂直合并。
此函数将取 word 中的第一个 table,并将删除 MS Word 中 table 的所有单元格的所有垂直合并。
Function SplitVerticalMerge()
'Created by Chandraprakash [Yoh]
Dim i As Long, j As Long, k As Long, cols As Long, m As Long
Dim sData() As Variant
Dim oTable As Table
Dim oCell As Cell
Dim oRng As Range
Dim sText As String
Dim sRow As String
Dim iRow As Long
'Rows of Merged and NonMerged cells in Table
Dim oColl1 As New Collection
'Row with number of merged cells in Table (Vertical Split Number)
Dim oColl2 As New Collection
Set oTable = ActiveDocument.Tables(1)
With oTable
'Load all the Table cell index
ReDim sData(1 To .Rows.Count, 1 To .Columns.Count)
Set oCell = .Cell(1, 1)
Do While Not oCell Is Nothing
sData(oCell.RowIndex, oCell.ColumnIndex) = oCell.RowIndex & "," & oCell.ColumnIndex
Set oCell = oCell.Next
Loop
'1. Mark the merged cell as "X"
'2. Mark the non merged cell as "A"
'3. Load the result for each row to Collection1
For i = 1 To UBound(sData)
sRow = ""
For j = 1 To UBound(sData, 2)
sRow = sRow & IIf(IsEmpty(sData(i, j)), "X", "A") ' & "|"
Next j
oColl1.Add sRow
Next i
For cols = 1 To oTable.Columns.Count
'Load one by one Row with number of merged cells in Table (Vertical Split Number)
Set oColl2 = Nothing
j = 1
For i = oColl1.Count To 1 Step -1
'"X" - Merged
If Mid(oColl1(i), cols, 1) = "X" Then
j = j + 1
k = j
'"A" - NotMerged
Else
k = j
j = 1
End If
If j = 1 Then oColl2.Add k
Next i
iRow = oTable.Columns(cols).Cells.Count
k = iRow
For j = 1 To oColl2.Count
For i = oColl2.Count To 1 Step -iRow
'cols - Column Number
'k - cell row number in column (cols)
'j - Split number for the cell (k)
'Split the cell by above attributes defined
oTable.Columns(cols).Cells(k).Split oColl2(j), 1
'1. Enter if merged cell is split (j>1)
'2. Will fill the values for split empty cell with previous merged cell value
If oColl2(j) > 1 Then
For m = 1 To oColl2(j) - 1
oTable.Columns(cols).Cells(k + m).Range.Text = oTable.Columns(cols).Cells(k).Range.Text
Next m
End If
k = k - 1
Next i
Next j
Next cols
'To avoid application freezing
DoEvents
End With
lbl_Exit:
Set oColl1 = Nothing
Set oColl2 = Nothing
Set oTable = Nothing
Set oCell = Nothing
Set oRng = Nothing
Exit Function
End Function
参考: Graham Mayor 的基本代码 - MS MVP (Word) URL: http://www.vbaexpress.com/forum/showthread.php?59760-Unmerging-Vertically-merged-cells