• DİKKAT

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

Listbox sıra ,ad soyad

Katılım
11 Şubat 2010
Mesajlar
202
Excel Vers. ve Dili
13 türkçe
Merhaba,
Elimdeki bu kod içinde Listede sadece İsim çıkıyor. Acaba listede sıra, isim, soyad şeklinde görünmesi mümkün müdür?
Teşekkürler
Kod:
Private Sub ListBox1_Click()
On Error Resume Next
Sheets("deneme").Select
Dim x As Integer
x = Sheets("deneme").Range("B:b").Cells.Find(What:=ListBox1, LookIn:=xlValues).Row
TextBox1.Value = ListBox1
ComboBox1 = Sheets("deneme").Cells(x, 2)
Range("A2:IV" & [a65536].End(3).Row).Interior.ColorIndex = 32
  Dim bak As Range
    For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
        If StrConv(bak.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then
            bak.Select
            TextBox1.Value = ActiveCell.Offset(0, -1).Value
            ComboBox1.Value = ActiveCell.Offset(0, 0).Value
            TextBox13.Value = ActiveCell.Offset(0, 2).Value
            TextBox3.Value = ActiveCell.Offset(0, 3).Value
            TextBox4.Value = ActiveCell.Offset(0, 4).Value
            TextBox5.Value = ActiveCell.Offset(0, 5).Value
            TextBox6.Value = ActiveCell.Offset(0, 6).Value
            TextBox7.Value = ActiveCell.Offset(0, 7).Value
            TextBox8.Value = ActiveCell.Offset(0, 8).Value
            TextBox9.Value = ActiveCell.Offset(0, 9).Value
            TextBox10.Value = ActiveCell.Offset(0, 10).Value
            TextBox11.Value = ActiveCell.Offset(0, 11).Value
            ComboBox3.Value = ActiveCell.Offset(0, 12).Value
                        Temizle.Enabled = True
    Sil.Enabled = True
degistir.Enabled = True
Yenikayit.Enabled = False
            Exit Sub
        End If
    Next bak
    Temizle.Enabled = True
    Sil.Enabled = True
degistir.Enabled = True
Yenikayit.Enabled = False
    ComboBox2.SetFocus

End Sub
 

Ekli dosyalar

Kaldırmış olduğunuz sayfalar ve userformda enabled disabled ların olmayan sayfalara başvurusu nedeni ile dosya felç geçiriyor.

Diğer yandan , sayfada ( adını değiştirsem de ) 19 veri hücresi varken userformda aynı sayıda textbox yok.

Dosya anlaşılır olmaktan uzak.
 
Haklısınız .Kafam o kadar karışmış ki dosyanın bu kadar karmaşık olması doğal. Afola..
Ekliyorum umarım bu kez olur.
 

Ekli dosyalar

Kod:
Private Sub ListBox1_Click()
On Error Resume Next
Sheets("deneme").Select
Dim x As Integer
x = Sheets("deneme").Range("A:A").Cells.Find(What:=ListBox1, LookIn:=xlValues).Row
ComboBox1.Value = ListBox1
ComboBox1 = Sheets("deneme").Cells(x, 2)
Range("A2:IV" & [a65536].End(3).Row).Interior.ColorIndex = 32
  Dim bak As Range
    For Each bak In Range("B1:c" & WorksheetFunction.CountA(Range("B1:B65000")))
        If StrConv(bak.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then
            bak.Select
            TextBox1.Value = ActiveCell.Offset(0, -1).Value
            ComboBox1.Value = ActiveCell.Offset(0, 0).Value
            TextBox2.Value = ActiveCell.Offset(0, 1).Value
            TextBox3.Value = ActiveCell.Offset(0, 2).Value
            TextBox4.Value = ActiveCell.Offset(0, 3).Value
           If ActiveCell.Offset(0, 4).Value = "Bay" Then
        OptionButton1.Value = True
        Else
        OptionButton2.Value = True
        End If
            TextBox5.Value = ActiveCell.Offset(0, 5).Value
           

 
             Temizle.Enabled = True
    Sil.Enabled = True
degistir.Enabled = True
Yenikayit.Enabled = False
            Exit Sub
        End If
    Next bak
    Temizle.Enabled = True
    Sil.Enabled = True
degistir.Enabled = True
Yenikayit.Enabled = False
    ComboBox2.SetFocus

End Sub



Private Sub UserForm_Initialize()
On Error Resume Next
Dim MyRange As Range
Dim noA As Integer
noA = WorksheetFunction.CountA(Sheets("deneme").Range("B:B"))
ListBox1.ColumnCount = 3
ListBox1.ColumnWidths = "25;50;50"
For i = 2 To noA
'For Each MyRange In Sheets("deneme").Range("B2:B" & noA)
If Left(Sheets("deneme").Cells(i, 2), Len(ComboBox2)) = LCase(ComboBox2) Then
    ListBox1.AddItem
    ListBox1.List(S, 0) = Cells(i, "A")
    ListBox1.List(S, 1) = Cells(i, "B")
    ListBox1.List(S, 2) = Cells(i, "C")
    S = S + 1
End If
Next

ComboBox1.SetFocus
Temizle.Enabled = False
Sil.Enabled = False
degistir.Enabled = False
ComboBox3.RowSource = "veri!c4:c9"
ComboBox4.RowSource = "giris!b1:b6"
End Sub
 
Listede göründü fakat değiştir butonu hata verdi. No kayıt için uyarı veriyor.
 
Ayrıca yeni kayıt yapıldığında kod olmuyor.
 
Özür dileyerek düzeltiyorum. Kayıt no hatası benden kaynaklı. Onu düzeltim. Fakat yeni kayıt veya değiştir yaptıktan sonra sadece isim çıkıyor. Teşekkürler sabrınız için.
 
Kod:
Private Sub ComboBox2_Change()
On Error Resume Next
ComboBox2 = (ComboBox2)
Dim MyRange As Range
Dim noA As Integer
noA = WorksheetFunction.CountA(Sheets("deneme").Range("B:B"))
ListBox1.ColumnCount = 3
ListBox1.ColumnWidths = "25;50;50"
For i = 2 To noA
'For Each MyRange In Sheets("deneme").Range("B2:B" & noA)
If Left(Sheets("deneme").Cells(i, 2), Len(ComboBox2)) = LCase(ComboBox2) Then
    ListBox1.AddItem
    ListBox1.List(S, 0) = Cells(i, "A")
    ListBox1.List(S, 1) = Cells(i, "B")
    ListBox1.List(S, 2) = Cells(i, "C")
    S = S + 1
End If
Next

'ListBox1.Clear
'noA = WorksheetFunction.CountA(Sheets("deneme").Range("B:B"))
'For Each MyRange In Sheets("deneme").Range("B2:B" & noA)
'If Left(LCase(MyRange), Len(ComboBox2)) = LCase(ComboBox2) Then ListBox1.AddItem (MyRange)
'Next
End Sub
 
Askm cevabınız için teşekkür ediyorum. Fakat olmadı. Acaba sorun nerede yardımcı olur musunuz.
 
Bende 3 sutun olarak geliyor. Olmayan kısım neresi anlamadım. Dosyanızın son halini atın bakalım.
 
Haklısınız. Yeni kayıt yaptıktan sonra veya değiştir dediğimde farklı çıkıyor.
 
Hata nerde olduğunu ve dosyanın son halini ekleyin bakayım. Haklısınız. "Yeni kayıt yaptıktan sonra veya değiştir dediğimde farklı çıkıyor." yazınca bende sorun çözüldü diye düşünmüştüm.
 
Zor oldu ama çözdüm.Biraz da karmaşık oldu. Sizlerde gelen bilgilerle daha iyi öğrenmiş olurdum.Teşekkürler
 
Geri
Üst