我正在嘗試制作一個宏，當 A 列中的文本不是粗體時，它將自動對所有行進行分組（折疊）。我還沒有任何代碼，但是當我之前根據單元格顏色完成它時，從這里獲取的代碼，它沒有根據提供的解決方案作業。任何幫助將不勝感激。
出現時的行
分組時的行，這是我手動完成的。
uj5u.com熱心網友回復：
我更新了您參考的代碼以檢查該Range.Font.Bold屬性。此代碼假定A為具有粗體值的列。
Sub RowGrouper()
Dim rng As Range
Dim lastRow As Long
lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For Each rng In Range(Cells(1, 1), Cells(lastRow, 1)).Cells
If rng.Font.Bold Then
rng.Rows.Group
End If
Next
End Sub
uj5u.com熱心網友回復：
只需閱讀有關條件格式的附加資訊。
因此，在這種情況下，您可以簡單地使用該DisplayFormat方法并運行相同的方法。
Sub SetGroups()
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range, pCell As Range
'Dim dict As Scripting.Dictionary => use if adding the reference 'Microsoft Scripting Runtime'
'Set dict = New Scripting.Dictionary
Dim dict As Object '=> use when NOT adding the reference 'Microsoft Scripting Runtime'
Set dict = CreateObject("Scripting.Dictionary")
Set ws = ActiveSheet
Set rng = ws.UsedRange
'Set grouping button to top row
With ws.Outline
.AutomaticStyles = False
.SummaryRow = xlAbove
.SummaryColumn = xlRight
End With
For Each cell In rng.Cells
If pCell Is Nothing Then
Set pCell = cell
End If
'If cell.Font.Bold And Not dict.Exists(cell.row) Then
If cell.DisplayFormat.Font.Bold And Not dict.Exists(cell.row) Then
dict.Add cell.row, cell.row
Set pCell = cell
End If
If dict.Exists(pCell.row) Then
dict.Item(pCell.row) = cell.row
End If
Next
'ungroup all used rows
rng.Rows.ClearOutline
For Each Key In dict.Keys
If (dict(Key) > Key) Then
Range(Rows(Key 1), Rows(dict(Key))).Rows.Group
End If
Next
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/caozuo/519608.html
標籤：擅长vba
上一篇：提取word檔案中的文本參考
下一篇：單元格范圍在公式中自動移動