Listbox Çoklu Seçim

[ahmed_ummu]

Merhaba arkadaşlar.

Ekte örnek olarak eklediğim dosyadaki "Tanımlı Branşları Seç" butonuna tıklandığında, Sayfa1 B sütununda bulunan branşların Listbox'ta seçmesini nasıl yapabilirim. Yardımcı olursanız çok sevinirim.

 

[Greenblacksea53]

Dosyanız ekte

 

[veyselemre]

Private Sub CommandButton1_Click()
    Dim veri
    Dim sonA, sonB, sn
    sonA = Cells(Rows.Count, "A").End(3).Row
    sonB = Cells(Rows.Count, "B").End(3).Row
    sn = Evaluate("=IFERROR(MATCH(B1:B" & sonB & ",$A$1:$A$" & sonA & ",0)-1,-1)")
    If IsArray(sn) Then
        For Each s In sn
            If s <> -1 Then ListBox1.Selected(s) = True
        Next s
    End If
End Sub

 

[ahmed_ummu]

Dosyanız ekte

Private Sub CommandButton1_Click()
    Dim veri
    Dim sonA, sonB, sn
    sonA = Cells(Rows.Count, "A").End(3).Row
    sonB = Cells(Rows.Count, "B").End(3).Row
    sn = Evaluate("=IFERROR(MATCH(B1:B" & sonB & ",$A$1:$A$" & sonA & ",0)-1,-1)")
    If IsArray(sn) Then
        For Each s In sn
            If s <> -1 Then ListBox1.Selected(s) = True
        Next s
    End If
End Sub

Çok teşekkürler sayın veyselemre

 

[ahmed_ummu]

Dosyanız ekte

İlginize teşekkürler sayın
Greenblacksea53

Ban yanlış anlatmış olabilirim. Gönderdiğiniz dosyada tanımlı branşları Listbox'ta listeliyor. Tanımlı branşların Listbox'ta seçilmesini yapmak istemiştim.

 

[veyselemre]

Private Sub CommandButton1_Click()
    Dim sonA, sonB, sn, s
    sonA = Cells(Rows.Count, "A").End(3).Row
    With ListBox1
        If .Tag = "" Then .Tag = False
        If CBool(.Tag) Then
            .RowSource = "Sayfa1!A1:A" & sonA
            CommandButton1.Caption = "Tanımlı Branşları Seç"
        Else
            sonB = Cells(Rows.Count, "B").End(3).Row
            sn = Evaluate("TRANSPOSE(IFERROR(MATCH(B1:B" & sonB & ",$A$1:$A$" & sonA & ",0)-1,""-""))")
            If Not IsArray(sn) Then sn = Array(sn)
            For Each s In Filter(sn, "-", False)
                .Selected(s) = True
            Next s
            CommandButton1.Caption = "Seçimi Temizle"
        End If
        .Tag = Not CBool(.Tag)
    End With
End Sub

 

[ahmed_ummu]

Private Sub CommandButton1_Click()
    Dim sonA, sonB, sn, s
    sonA = Cells(Rows.Count, "A").End(3).Row
    With ListBox1
        If .Tag = "" Then .Tag = False
        If CBool(.Tag) Then
            .RowSource = "Sayfa1!A1:A" & sonA
            CommandButton1.Caption = "Tanımlı Branşları Seç"
        Else
            sonB = Cells(Rows.Count, "B").End(3).Row
            sn = Evaluate("TRANSPOSE(IFERROR(MATCH(B1:B" & sonB & ",$A$1:$A$" & sonA & ",0)-1,""-""))")
            If Not IsArray(sn) Then sn = Array(sn)
            For Each s In Filter(sn, "-", False)
                .Selected(s) = True
            Next s
            CommandButton1.Caption = "Seçimi Temizle"
        End If
        .Tag = Not CBool(.Tag)
    End With
End Sub

Çok teşekkürler sayın veyselemre

 

[ahmed_ummu]

Private Sub CommandButton1_Click()
    Dim sonA, sonB, sn, s
    sonA = Cells(Rows.Count, "A").End(3).Row
    With ListBox1
        If .Tag = "" Then .Tag = False
        If CBool(.Tag) Then
            .RowSource = "Sayfa1!A1:A" & sonA
            CommandButton1.Caption = "Tanımlı Branşları Seç"
        Else
            sonB = Cells(Rows.Count, "B").End(3).Row
            sn = Evaluate("TRANSPOSE(IFERROR(MATCH(B1:B" & sonB & ",$A$1:$A$" & sonA & ",0)-1,""-""))")
            If Not IsArray(sn) Then sn = Array(sn)
            For Each s In Filter(sn, "-", False)
                .Selected(s) = True
            Next s
            CommandButton1.Caption = "Seçimi Temizle"
        End If
        .Tag = Not CBool(.Tag)
    End With
End Sub

Merhaba sayın veyselemre

Gönderdiğiniz kodu kendi dosyama uyarlayamadım.

Konuyu açarken eklediğim dosya örnek idi. Kendi dosyam büyük olduğu için onu göndermemiştir.

Yapmak istediğm, Parametreler sayfasındaki AH sütunundaki branşları Listbox8 de seçili hale getirecek. Sayın veyselemre sizin kodlarınızda aşağıda ki gibi değişiklik yaptım ama bu haliyle Listbox8 deki tüm branşları seçiyor. "parametreler" sayfasındaki AH sütununda bulunan branşları Listbox8 de seçecek. Bi daha bakarsanız sevinirim.

Dim sonA, sonB, sn, s
sonA = Cells(Rows.Count, "ah").End(3).Row
With ListBox8
If .Tag = "" Then .Tag = False
If CBool(.Tag) Then
.RowSource = "parametreler!ah1:ah" & sonA
Label513.Caption = "Tanımlı Branşları Seç"
Else
sonA = Cells(Rows.Count, "ah").End(3).Row
sn = Evaluate("TRANSPOSE(IFERROR(MATCH(ah1:ah" & sonA & ",$AH$1:$AH$" & sonA & ",0)-1,""-""))")
If Not IsArray(sn) Then sn = Array(sn)
For Each s In Filter(sn, "-", False)
.Selected(s) = True
Next s
Label513.Caption = "Seçimi Temizle"
End If
.Tag = Not CBool(.Tag)
End With

 

[veyselemre]

örnek dosya eklemeniz gerekir

 

[ahmed_ummu]

örnek dosya eklemeniz gerekir

Çok teşekkürler sayın veyselemre gönderdiğiniz kodları aşağıdaki şekilde değiştirince oldu.

Dim sonA, sonB, sn
Set p = Sheets("parametreler")
sonA = p.Cells(Rows.Count, "d").End(3).Row
sonB = p.Cells(Rows.Count, "ah").End(3).Row
sn = Evaluate("=IFERROR(MATCH(ah1:ah" & sonB & ",$d$1:$d$" & sonA & ",0)-1,-1)")
If IsArray(sn) Then
For Each s In sn
If s <> -1 Then ListBox8.Selected(s) = True
Next s
End If