Verilen Alanı ListBox Üzerinde Listele - Microsoft Excel


Listelenecek alan ve ListBox parametreleri girildiğinde ilgili ListBox nesnesine alan verilerini listeliyor.

Kod


Option Explicit

Sub VeriyiDiziyeAktarVeListBoxUzerindeListele(lb As MSForms.ListBox, veri As Range)
    
    '--------------------------------------------------
    'Değişkenler
    '--------------------------------------------------
    Dim dizi           As Variant
    Dim i              As Long
    Dim j              As Long
    Dim son_dolu_satir As Long
    Dim son_dolu_sutun As Long
    
    '--------------------------------------------------
    'ListBox ayarla.
    '--------------------------------------------------
    lb.Clear
    lb.ColumnCount = veri.Columns.Count
    
    '--------------------------------------------------
    'Değişkenlere değer ata.
    '--------------------------------------------------
    son_dolu_satir = Cells(1048576, veri.Column).End(xlUp).Row
    son_dolu_sutun = Cells(veri.Row, 16384).End(xlToLeft).Column
    
    '--------------------------------------------------
    'Dizi ayarla.
    '--------------------------------------------------
    ReDim dizi(son_dolu_satir - 1, veri.Columns.Count)
    
    '--------------------------------------------------
    'Ekleme yap.
    '--------------------------------------------------
    For i = 0 To son_dolu_satir - 1
        For j = 0 To son_dolu_sutun - 1
            dizi(i, j) = veri.Cells(i + 1, j + 1).Text
        Next
    Next
    
    '--------------------------------------------------
    'Listele
    '--------------------------------------------------
    lb.List = dizi
End Sub

Kod (Açıklamalı)


Option Explicit

Sub VeriyiDiziyeAktarVeListBoxUzerindeListele(lb As MSForms.ListBox, veri As Range)
    
    '--------------------------------------------------
    'Değişkenler
    '--------------------------------------------------
    Dim dizi           As Variant
    Dim i              As Long
    Dim j              As Long
    Dim son_dolu_satir As Long
    Dim son_dolu_sutun As Long
    
    '--------------------------------------------------
    'Listeleme yapmadan önce ListBox nesnesini temizle.
    '--------------------------------------------------
    lb.Clear
    
    '--------------------------------------------------
    'ListBox için sütun sayısını belirle.
    '--------------------------------------------------
    lb.ColumnCount = veri.Columns.Count
    
    '--------------------------------------------------
    'Verilen alanın sınırlarını (satır, sütun) öğren.
    '--------------------------------------------------
    son_dolu_satir = Cells(1048576, veri.Column).End(xlUp).Row
    son_dolu_sutun = Cells(veri.Row, 16384).End(xlToLeft).Column
    
    '--------------------------------------------------
    'Diziyi de verilen alanın boyutuna göre ayarla.
    '--------------------------------------------------
    ReDim dizi(son_dolu_satir - 1, veri.Columns.Count)
    
    '--------------------------------------------------
    'Her satır için işlem yap.
    '--------------------------------------------------
    For i = 0 To son_dolu_satir - 1
        
        '--------------------------------------------------
        'İlgili satırdaki bütün sütunların
        'içeriklerini diziye aktar.
        '--------------------------------------------------
        For j = 0 To son_dolu_sutun - 1
            dizi(i, j) = veri.Cells(i + 1, j + 1).Text
        Next
    Next
    
    '--------------------------------------------------
    'dizi içeriğini ListBox nesnesi üzerinde göster.
    '--------------------------------------------------
    lb.List = dizi
End Sub

Kullanım


Private Sub UserForm_Initialize()
    
    '--------------------------------------------------
    'IcerikUserForm nesnesi üzerindeki
    'ListBox1 nesnesine listeleme yap.
    '
    'Form başlatılırken yükle.
    '
    'Liste içeriği B3:F20 alanından
    'yükleniyor.
    '--------------------------------------------------
    VeriyiDiziyeAktarVeListBoxUzerindeListele ListBox1, Range("B3:F20")
End Sub

Etiketler
microsoft excel açıklamalı içerik microsoft excel vba