Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 06-12-2017, 10:52   #1
xemdarx
Altın Üye
 
xemdarx kullanıcısının avatarı
 
Giriş: 11/02/2010
Şehir: Edirne
Mesaj: 37
Excel Vers. ve Dili:
13 türkçe
Varsayılan Listbox sıra ,ad soyad

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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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
Eklenmiş Dosyalar
Dosya Türü: xls deneme prgm.xls (299.0 KB, 5 Görüntülenme)
xemdarx Çevrimdışı   Alıntı Yaparak Cevapla
Eski 06-12-2017, 11:59   #2
cems
Altın Üye
 
cems kullanıcısının avatarı
 
Giriş: 02/09/2005
Şehir: İstanbul
Mesaj: 1,593
Excel Vers. ve Dili:
office 2003 tr + office 2010 tr
Varsayılan

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.
cems Çevrimdışı   Alıntı Yaparak Cevapla
Eski 06-12-2017, 12:51   #3
xemdarx
Altın Üye
 
xemdarx kullanıcısının avatarı
 
Giriş: 11/02/2010
Şehir: Edirne
Mesaj: 37
Excel Vers. ve Dili:
13 türkçe
Varsayılan

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.
Eklenmiş Dosyalar
Dosya Türü: xls deneme prgm.xls (185.0 KB, 7 Görüntülenme)
xemdarx Çevrimdışı   Alıntı Yaparak Cevapla
Eski 06-12-2017, 13:04   #4
askm
Altın Üye
 
Giriş: 04/06/2005
Şehir: k.maraş
Mesaj: 1,702
Excel Vers. ve Dili:
2010-2016
Varsayılan

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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
__________________
excel 2010- türkçe
askm Çevrimiçi   Alıntı Yaparak Cevapla
Eski 06-12-2017, 13:19   #5
xemdarx
Altın Üye
 
xemdarx kullanıcısının avatarı
 
Giriş: 11/02/2010
Şehir: Edirne
Mesaj: 37
Excel Vers. ve Dili:
13 türkçe
Varsayılan

Listede göründü fakat değiştir butonu hata verdi. No kayıt için uyarı veriyor.
xemdarx Çevrimdışı   Alıntı Yaparak Cevapla
Eski 06-12-2017, 13:20   #6
xemdarx
Altın Üye
 
xemdarx kullanıcısının avatarı
 
Giriş: 11/02/2010
Şehir: Edirne
Mesaj: 37
Excel Vers. ve Dili:
13 türkçe
Varsayılan

Ayrıca yeni kayıt yapıldığında kod olmuyor.
xemdarx Çevrimdışı   Alıntı Yaparak Cevapla
Eski 06-12-2017, 13:49   #7
xemdarx
Altın Üye
 
xemdarx kullanıcısının avatarı
 
Giriş: 11/02/2010
Şehir: Edirne
Mesaj: 37
Excel Vers. ve Dili:
13 türkçe
Varsayılan

Ö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.
xemdarx Çevrimdışı   Alıntı Yaparak Cevapla
Eski 06-12-2017, 14:07   #8
askm
Altın Üye
 
Giriş: 04/06/2005
Şehir: k.maraş
Mesaj: 1,702
Excel Vers. ve Dili:
2010-2016
Varsayılan

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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
__________________
excel 2010- türkçe
askm Çevrimiçi   Alıntı Yaparak Cevapla
Eski 06-12-2017, 20:32   #9
xemdarx
Altın Üye
 
xemdarx kullanıcısının avatarı
 
Giriş: 11/02/2010
Şehir: Edirne
Mesaj: 37
Excel Vers. ve Dili:
13 türkçe
Varsayılan

Askm cevabınız için teşekkür ediyorum. Fakat olmadı. Acaba sorun nerede yardımcı olur musunuz.
xemdarx Çevrimdışı   Alıntı Yaparak Cevapla
Eski 06-12-2017, 21:35   #10
askm
Altın Üye
 
Giriş: 04/06/2005
Şehir: k.maraş
Mesaj: 1,702
Excel Vers. ve Dili:
2010-2016
Varsayılan

Bende 3 sutun olarak geliyor. Olmayan kısım neresi anlamadım. Dosyanızın son halini atın bakalım.
__________________
excel 2010- türkçe
askm Çevrimiçi   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 22:42


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım -- Beylikdüzü mali müşavir - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Özel Eğitim- Site Yönetimi- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Araç Takip- Çorlu Su Arıtma- Gebze Emlak- Bakır Sülfat- Rampa- Rotary- Çorlu İnternet Sitesi- youngblood- Çorlu Sürücü Kursu- Çorlu Sandviç Panel- Şişli Avukat- Korona Test Kalemi- Çorlu Vinç- Çorlu Pimapen Tamiri- Çorlu Çelik Konstruksiyon- Çorlu Dans- Edirne Serbest Muhasebeci- Çorlu Etüt- İstanbul Botanik- Çorlu Sigorta-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden