Soru Listbox

[sirkülasyon]

Selamün Aleyküm
Sayfa1 G2 : G arasında olan verileri Listbox1' e hem benzersiz hem de boşluksuz almak için yardımcı olabilir misiniz?
Saygılarımla

 

[cems]

Dosya yok

 

[Muzaffer Ali]

Aleyküm selam.
Aşağıdaki kodu kullanabilirsiniz.

Sub Test()
    Dim syf As Worksheet
    Dim Bak As Integer
    Worksheets("Sayfa1").Columns("G:G").Copy
    Set syf = Sheets.Add
    syf.Paste
    Application.CutCopyMode = False
    syf.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
    For Bak = syf.Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
        If syf.Cells(Bak, "A") = "" Then Rows(Bak).Delete
    Next
    ListBox1.List = syf.Range("A2:A" & syf.Cells(Rows.Count, "A").End(xlUp).Row).Formula
    Application.DisplayAlerts = False
    syf.Delete
    Application.DisplayAlerts = True
End Sub

 

[Ziynettin]

Alternatif,

Option Explicit
Private Sub CommandButton1_Click()
    Dim s1 As Worksheet, dc As Object
    Dim a(), i As Long, son As Long
    Set s1 = Sheets("Sayfa1")
    Set dc = CreateObject("scripting.dictionary")
    son = s1.Cells(Rows.Count, "G").End(xlUp).Row
    If son > 1 Then
        a = s1.Range("G1:G" & son).Value
        For i = 2 To UBound(a)
            If a(i, 1) <> "" Then dc(a(i, 1)) = ""
        Next i
        ListBox1.List = dc.keys
    End If
End Sub

 

[sirkülasyon]

Yardımlarınızı esirgemediğiniz için teşekkürlerimi sunarım.
Allah razı olsun