大家好,
请查看上面有两张桌子的图片。在带有以下代码的第一个表格中,我得到了这种格式。
但是我希望像Table2一样格式化,并且每个合并单元格中的行数是动态的,并且它们不一样。
有没有办法格式化像table2?
Range("B6:H" & LastRow2).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
答案 0 :(得分:3)
只需将此代码添加到上述代码的末尾
即可For i = 6 To LastRow2
If Range("B" & i - 1).MergeCells = True And Range("B" & i).MergeCells = True And _
Range("B" & i - 1).MergeArea.Address = Range("B" & i).MergeArea.Address Then
Range("B" & i - 1 & ":H" & i).Borders(xlInsideHorizontal).LineStyle = xlNone
End If
Next i
因此,如果我将代码和代码组合在一起,那么它将看起来像这样
StartRow = 6 '<~~ For example
LastRow = 25 '<~~ For example
With Range("B" & StartRow & ":H" & LastRow)
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
End With
On Error Resume Next '<~~ Required if the StartRow = 1
For i = StartRow To LastRow
If Range("B" & i - 1).MergeCells = True And Range("B" & i).MergeCells = True And _
Range("B" & i - 1).MergeArea.Address = Range("B" & i).MergeArea.Address Then
Range("B" & i - 1 & ":H" & i).Borders(xlInsideHorizontal).LineStyle = xlNone
End If
Next i
On Error GoTo 0
示例强>
答案 1 :(得分:1)
以下是执行此任务的代码。您需要传递初始单元格的地址(使用文本&#39; Column1 &#39;)作为此函数的输入参数,即Call formatArray("A2")
。
数组的第一列和最后一列定义为常量FIRST_COL
和LAST_COL
,当前设置为1和5 - 如果数组位于其他列中,只需更改常量值。 / p>
Public Sub formatArray(startCell As String)
Const FIRST_COL As Integer = 1
Const LAST_COL As Integer = 5
'--------------------------------------------
Dim wks As Excel.Worksheet
Dim initialCell As Excel.Range
'--------------------------------------------
Dim region As Excel.Range
Dim firstRow As Long
Dim lastRow As Long
Dim row As Long
Dim rng As Excel.Range
Dim groups As New VBA.Collection
Dim groupStartRow As Long
'--------------------------------------------
Set wks = Excel.ActiveSheet
Set initialCell = wks.Range(startCell)
Set region = initialCell.CurrentRegion
firstRow = initialCell.row
lastRow = region.Cells(region.Cells.Count).row
'Divide range into groups. -----------------------------------------------------
For row = firstRow To lastRow
If Not IsEmpty(wks.Cells(row, FIRST_COL).value) Or row = lastRow Then
If groupStartRow Then
With wks
Set rng = .Range(.Cells(groupStartRow, FIRST_COL), _
.Cells(IIf(row = lastRow, row, row - 1), LAST_COL))
Call groups.Add(rng)
End With
End If
groupStartRow = row
End If
Next row
'-------------------------------------------------------------------------------
'At this point whole region is divided into smaller parts. Each part contains
'the rows that are merged in first column. Now we apply border formatting to
'each subregion separately.
For Each rng In groups
With rng
Call .BorderAround(xlContinuous, xlThick, 0, 0)
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 15
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 15
.Weight = xlThin
End With
End With
Next rng
End Sub