Seçili Aralığa Ait Bilgileri Listeleme

Sub RangeDescription()
    Dim NumCols As Integer
    Dim NumRows As Long
    Dim NumBlocks As Integer
    Dim NumCells As Double
    Dim NumAreas As Integer
    Dim SelType As String
    Dim FirstAreaType As String
    Dim CurrentType  As String
    Dim WhatSelected As String
    Dim UnionRange As Range
    Dim Area As Range
    Dim Msg As String

    If TypeName(Selection) <> "Range" Then
  MsgBox "Select a range."
  Exit Sub
    End If

    NumCols = 0
    NumRows = 0
    NumBlocks = 0
    NumCells = 0

    NumAreas = Selection.Areas.Count
    If NumAreas = 1 Then
  SelType = "Single Selection"
    Else
  SelType = "Multiple Selection"
    End If

    FirstAreaType = AreaType(Selection.Areas(1))
    WhatSelected = FirstAreaType

    Set UnionRange = Selection.Areas(1)
    
    For Each Area In Selection.Areas
  CurrentType = AreaType(Area)

  If CurrentType = "Block" Then NumBlocks = NumBlocks + 1
  Set UnionRange = Union(UnionRange, Area)

  If CurrentType <> FirstAreaType Then WhatSelected = "Mixed"
    Next Area

    For Each Area In UnionRange.Areas
  Select Case AreaType(Area)
Case "Row"
    NumRows = NumRows + Area.Rows.Count
Case "Column"
    NumCols = NumCols + Area.Columns.Count
Case "Worksheet"
    NumCols = NumCols + Area.Columns.Count
    NumRows = NumRows + Area.Rows.Count
Case "Block"
  End Select
     Next Area

    NumCells = UnionRange.CountLarge

    Msg = "Selection Type:" &amp; vbTab &amp; WhatSelected &amp; vbCrLf
    Msg = Msg &amp; "No. of Areas:" &amp; vbTab &amp; NumAreas &amp; vbCrLf
    Msg = Msg &amp; "Full Columns: " &amp; vbTab &amp; NumCols &amp; vbCrLf
    Msg = Msg &amp; "Full Rows: " &amp; vbTab &amp; NumRows &amp; vbCrLf
    Msg = Msg &amp; "Cell Blocks:" &amp; vbTab &amp; NumBlocks &amp; vbCrLf
    Msg = Msg &amp; "Total Cells: " &amp; vbTab &amp; Format(NumCells, "#,###")
    MsgBox Msg, vbInformation, SelType
End Sub

Private Function AreaType(RangeArea As Range) As String
    Select Case True
  Case RangeArea.Cells.CountLarge = 1
AreaType = "Cell"
  Case RangeArea.CountLarge = Cells.CountLarge
AreaType = "Worksheet"
  Case RangeArea.Rows.Count = Cells.Rows.Count
AreaType = "Column"
  Case RangeArea.Columns.Count = Cells.Columns.Count
AreaType = "Row"
  Case Else
AreaType = "Block"
    End Select
End Function