D
D
dflbrhekbn2016-07-14 14:00:49
Visual Basic
dflbrhekbn, 2016-07-14 14:00:49

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

1 answer(s)
I
idShura, 2016-07-25
@dflbrhekbn

I didn't fully understand the question. The range of cells that are processed is specified in the line Set iRange = ActiveSheet.UsedRange

Didn't find what you were looking for?

Ask your question

Ask a Question

731 491 924 answers to any question