Answer the question
In order to leave comments, you need to log in
How and in what to specify a range of merged cells in VBA?
There is a macro that automatically selects the height of the merged cells as it fills up and hides those in which there is nothing at all. How and where to specify a range of specific merged cells of cells, and not all cells on a sheet?
Sub Ìàêðîñ1()
'
' Ìàêðîñ1 Ìàêðîñ
'
'
Rows("5:7").RowHeight = 0
Range("A4:C7").Select
ActiveCell.FormulaR1C1 = "1"
Range("A8").Select
Rows("7:7").EntireRow.AutoFit
Rows("6:6").EntireRow.AutoFit
Rows("5:5").EntireRow.AutoFit
Rows("4:4").EntireRow.AutoFit
Rows("7:7").RowHeight = 14.25
End Sub
Sub Ìàêðîñ2()
'
' Ìàêðîñ2 Ìàêðîñ
'
'
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub
Sub Ìàêðîñ3()
'
' Ìàêðîñ3 Ìàêðîñ
'
'
Range("A4:C7").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
End Sub
Sub test()
On Error Resume Next
Application.ScreenUpdating = False
Dim coll As New Collection
Dim iRange As Range
Dim iCell As Range
Set iRange = ActiveSheet.UsedRange
For Each iCell In iRange
If iCell.MergeCells Then
coll.Add iCell.MergeArea.Address, iCell.MergeArea.Address
If Err.Number = 0 Then
If iCell.Value = "" Then
iCell.MergeArea.RowHeight = 0
Else
y = iCell.MergeArea.ColumnWidth
Set sh = Sheets.Add
With sh.Cells(1, 1)
.HorizontalAlignment = iCell.MergeArea.HorizontalAlignment
.VerticalAlignment = iCell.MergeArea.VerticalAlignment
.WrapText = True
.ColumnWidth = y * iCell.MergeArea.Columns.Count
.Value = iCell.Value
.EntireRow.AutoFit
x1 = .RowHeight
End With
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
iCell.MergeArea.RowHeight = x1 / iCell.MergeArea.Rows.Count
End If
Else
Err.Clear
End If
End If
Next
Application.ScreenUpdating = True
End Sub
Answer the question
In order to leave comments, you need to log in
Didn't find what you were looking for?
Ask your questionAsk a Question
731 491 924 answers to any question