Seçili Aralığa Ait Bilgilerin Listelenmesi
05 Ağustos 2021
1068
Seçili Aralığa Ait Bilgilerin Listelenmesi isimli içerikte, sayfa üzerinde seçtiğini aralığa ait bilgilerin özetini veren bir kod yer almaktadır.
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:" & vbTab & WhatSelected & vbCrLf
Msg = Msg & "No. of Areas:" & vbTab & NumAreas & vbCrLf
Msg = Msg & "Full Columns: " & vbTab & NumCols & vbCrLf
Msg = Msg & "Full Rows: " & vbTab & NumRows & vbCrLf
Msg = Msg & "Cell Blocks:" & vbTab & NumBlocks & vbCrLf
Msg = Msg & "Total Cells: " & vbTab & 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 FunctionGerekli Adımlar
Kodu çalıştırmanız için aşağıdaki adımları yerine getirmeniz gerekir.
- Microsoft Visual Basic for Applications penceresini (Alt + F11) açın.
- Project - VBAProject alanının, ekranın sol tarafında görüldüğünden emin olun. Görünmüyorsa, Ctrl + R kısayolu ile hızlıca açın.
- Araç çubuklarından Insert -> Module yazısına tıklayın.
- Solunda klasör simgesi olan Modules yazısının başındaki + simgesine tıklayın.
- Alt kısma eklenecek gelecek olan Module(1) yazısına çift tıklayın.
- Üstteki kodu yapıştırın.
Kod Açıklaması
Bu kodu kullanarak, bir hücre aralığındaki bilgilerin nasıl bulunacağını öğrenebilirsiniz.
Etiketler :
Hazır Dosyayı İndir
Dosyayı indirmek için giriş yapmanız ve VIP Üyelik Paketine sahip olmanız gerekir.
| YARARLI KISAYOLLAR | |
|---|---|
| İşlev Ekle Penceresini Açma | Shift F3 |
| Yapıştır Kısayolu | Ctrl V |
| Yapılanı İptal Etme | Esc |
| Tablonun Satırını Seçme | Shift Space |
| Şerit Menü Tuşlarını Aktif Etme / Alternatif | Shift F6 |