• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

ListBox Listeleme Sorunu

ozbinici07

ozbinici07

Katılım
8 Aralık 2017
Mesajlar
86
Merhaba Arkadaşlar
Aşağıda Örnek Olarak Atmış Olduğum VBA'da ComboBox1 e Yazdığımda Otomatik Arama Yapıyor Aynı İsimden Birden Fazla Kişi Varsa ListBox Açılarak Aynı İsimdeki Kişiler Karşıma Çıkıyor.

Sorunum İse Aynı İsimler Karşıma Çıkarken Yanında'da Soyadı Bilgilerininde Yer Alması Bana Yardımcı Olursanız Sevinirim.

Ekli dosyayı görüntüle Örnek.xlsm
 
Liste formunuzdaki kodu aşağıdaki gibi yapın

Kod: 
Private Sub UserForm_Activate()
ListBox1.ColumnCount = 3
ListBox1.List = Range("A1:C1").Value
ListBox1.ColumnWidths = "0;100;100"
End Sub
 
Diziyi aşağıdaki şekilde değiştirin
Kod: 
Private Sub arabul()
    If ComboBox1 = "" Then Exit Sub
    say = WorksheetFunction.CountIf(Sheets("DATA").Range("B:B"), ComboBox1)
    If say > 1 Then
        MsgBox "Birden fazla eşleşen kayıt bulundu!" & Chr(10) & "Listeden seçim yapabilirsiniz.", vbExclamation
        son = Sheets("DATA").Cells(Rows.Count, 1).End(3).Row
        ReDim dizi(1 To 2, 1 To 1)
        For Each veri In Sheets("DATA").Range("B4:B" & son)
            If CStr(veri.Value) = ComboBox1 Then
                X = X + 1
                ReDim Preserve dizi(1 To 2, 1 To X)
                dizi(2, X) = veri.Offset(0, 1).Value
                dizi(1, X) = veri.Value
            End If
        Next
        Call form
    Else
        Set bul = Sheets("DATA").Range("B:B").Find(ComboBox1, lookat:=xlWhole)
        If Not bul Is Nothing Then
            yontem = "degistir"
            TextBox2 = Cells(bul.Row, "c")
            TextBox3 = Cells(bul.Row, "d")
            TextBox4 = Cells(bul.Row, "e")
            TextBox5 = Cells(bul.Row, "f")

        End If
    End If
End Sub
Activate kodlarını da aşağıdaki şekilde değiştirin.
Kod: 
Private Sub UserForm_Activate()
ListBox1.ColumnCount = 2
ListBox1.List = Range("A1:C1").Value
ListBox1.ColumnWidths = "100;100"
ListBox1.Column = dizi
End Sub
 
@askm çok teşekkür ederim şimdi gösteriyor fakat üstüne tıkladığımda text lere yansıtmıyor(aktarmıyor)



askm' Alıntı:
Diziyi aşağıdaki şekilde değiştirin
Kod: 
Private Sub arabul()
    If ComboBox1 = "" Then Exit Sub
    say = WorksheetFunction.CountIf(Sheets("DATA").Range("B:B"), ComboBox1)
    If say > 1 Then
        MsgBox "Birden fazla eşleşen kayıt bulundu!" & Chr(10) & "Listeden seçim yapabilirsiniz.", vbExclamation
        son = Sheets("DATA").Cells(Rows.Count, 1).End(3).Row
        ReDim dizi(1 To 2, 1 To 1)
        For Each veri In Sheets("DATA").Range("B4:B" & son)
            If CStr(veri.Value) = ComboBox1 Then
                X = X + 1
                ReDim Preserve dizi(1 To 2, 1 To X)
                dizi(2, X) = veri.Offset(0, 1).Value
                dizi(1, X) = veri.Value
            End If
        Next
        Call form
    Else
        Set bul = Sheets("DATA").Range("B:B").Find(ComboBox1, lookat:=xlWhole)
        If Not bul Is Nothing Then
            yontem = "degistir"
            TextBox2 = Cells(bul.Row, "c")
            TextBox3 = Cells(bul.Row, "d")
            TextBox4 = Cells(bul.Row, "e")
            TextBox5 = Cells(bul.Row, "f")

        End If
    End If
End Sub
Activate kodlarını da aşağıdaki şekilde değiştirin.
Kod: 
Private Sub UserForm_Activate()
ListBox1.ColumnCount = 2
ListBox1.List = Range("A1:C1").Value
ListBox1.ColumnWidths = "100;100"
ListBox1.Column = dizi
End Sub
Genişletmek için tıkla ...
 
Dizi kısmını aşağıdaki şekilde değiştirin o zaman
Kod: 
Private Sub arabul()
    If ComboBox1 = "" Then Exit Sub
    say = WorksheetFunction.CountIf(Sheets("DATA").Range("B:B"), ComboBox1)
    If say > 1 Then
        MsgBox "Birden fazla eşleşen kayıt bulundu!" & Chr(10) & "Listeden seçim yapabilirsiniz.", vbExclamation
        son = Sheets("DATA").Cells(Rows.Count, 1).End(3).Row
        ReDim dizi(1 To 3, 1 To 1)
        For Each veri In Sheets("DATA").Range("B4:B" & son)
            If CStr(veri.Value) = ComboBox1 Then
                X = X + 1
                ReDim Preserve dizi(1 To 3, 1 To X)
                dizi(3, X) = veri.Offset(0, 1).Value
                dizi(2, X) = veri.Value
                dizi(1, X) = veri.Offset(0, -1).Value
            End If
        Next
        Call form
    Else
        Set bul = Sheets("DATA").Range("B:B").Find(ComboBox1, lookat:=xlWhole)
        If Not bul Is Nothing Then
            yontem = "degistir"
            TextBox2 = Cells(bul.Row, "c")
            TextBox3 = Cells(bul.Row, "d")
            TextBox4 = Cells(bul.Row, "e")
            TextBox5 = Cells(bul.Row, "f")

        End If
    End If
End Sub
Kod: 
Private Sub UserForm_Activate()
ListBox1.ColumnCount = 3
ListBox1.List = Range("A1:C1").Value
ListBox1.ColumnWidths = "0;100;100"
ListBox1.Column = dizi
End Sub
 
Teşekkür Ederim Yardımlarınız İçin Şuan Çalışıyor


askm' Alıntı:
Dizi kısmını aşağıdaki şekilde değiştirin o zaman
Kod: 
Private Sub arabul()
    If ComboBox1 = "" Then Exit Sub
    say = WorksheetFunction.CountIf(Sheets("DATA").Range("B:B"), ComboBox1)
    If say > 1 Then
        MsgBox "Birden fazla eşleşen kayıt bulundu!" & Chr(10) & "Listeden seçim yapabilirsiniz.", vbExclamation
        son = Sheets("DATA").Cells(Rows.Count, 1).End(3).Row
        ReDim dizi(1 To 3, 1 To 1)
        For Each veri In Sheets("DATA").Range("B4:B" & son)
            If CStr(veri.Value) = ComboBox1 Then
                X = X + 1
                ReDim Preserve dizi(1 To 3, 1 To X)
                dizi(3, X) = veri.Offset(0, 1).Value
                dizi(2, X) = veri.Value
                dizi(1, X) = veri.Offset(0, -1).Value
            End If
        Next
        Call form
    Else
        Set bul = Sheets("DATA").Range("B:B").Find(ComboBox1, lookat:=xlWhole)
        If Not bul Is Nothing Then
            yontem = "degistir"
            TextBox2 = Cells(bul.Row, "c")
            TextBox3 = Cells(bul.Row, "d")
            TextBox4 = Cells(bul.Row, "e")
            TextBox5 = Cells(bul.Row, "f")

        End If
    End If
End Sub
Kod: 
Private Sub UserForm_Activate()
ListBox1.ColumnCount = 3
ListBox1.List = Range("A1:C1").Value
ListBox1.ColumnWidths = "0;100;100"
ListBox1.Column = dizi
End Sub
Genişletmek için tıkla ...
 
Rica ederim. Kolay gelsin.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst