Telefon adres hızlı arama

[mami67]

Hepinize iyi yıllar.
Ekteki çalışmada alfabetik olarak kayıt tutabileceğimiz basit bir telefon adres tablosu var.
Masa üstünde sürekli kullandığım güncel tutduğum.
Benim istediğim endeks sayfasından, bir form vasıtası ile olabilir veya text box kutusu olabilir farketmez hızlı bir arama yapmak FİRMA ADI ve MÜŞTERİ ADI ile arama yapılabilsin örnek kutu içine firma adı ile arama yapmak için A yazdığımda A ile başlayan firmalar alfebatik olarak veya müşteri adı ile arama yapmak için A ile başlayan müşteri adları alfebatik olarak sıralansın

biraz karışık oldu galiba daha önce çok arama yaptım forumda telefon adres ile ilgili programlar buldum fakat bir telefon bulmak için çok uğraşıyosun yeni isim gireceksin çok uğraşıyosun bana basit bir hızlı arama metedu lazım yardımcı olursanız çok sevinirim

Esen kalın

 

[N.Ziya Hiçdurmaz]

yanıt

Private Sub TextBox1_Change()
Dim i, sat, s As Integer
ListBox1.Clear
ListBox1.ColumnCount = 8
For i = 2 To Sheets.Count
For sat = 3 To Sheets(i).Cells(65536, "b").End(xlUp).Row
If Sheets(i).Cells(sat, "b") Like TextBox1 & "*" Then
ListBox1.AddItem
ListBox1.List(s, 0) = Sheets(i).Cells(sat, "b")
ListBox1.List(s, 1) = Sheets(i).Cells(sat, "c")
ListBox1.List(s, 2) = Sheets(i).Cells(sat, "d")
ListBox1.List(s, 3) = Sheets(i).Cells(sat, "e")
ListBox1.List(s, 4) = Sheets(i).Cells(sat, "bf")
ListBox1.List(s, 5) = Sheets(i).Cells(sat, "g")
ListBox1.List(s, 6) = Sheets(i).Cells(sat, "h")
ListBox1.List(s, 7) = Sheets(i).Cells(sat, "ı")
s = s + 1
End If: Next: Next
End Sub
Private Sub TextBox2_Change()
Dim i, sat, s As Integer
ListBox1.Clear
ListBox1.ColumnCount = 8
For i = 2 To Sheets.Count
For sat = 3 To Sheets(i).Cells(65536, "c").End(xlUp).Row
If Sheets(i).Cells(sat, "c") Like TextBox2 & "*" Then
ListBox1.AddItem
ListBox1.List(s, 0) = Sheets(i).Cells(sat, "b")
ListBox1.List(s, 1) = Sheets(i).Cells(sat, "c")
ListBox1.List(s, 2) = Sheets(i).Cells(sat, "d")
ListBox1.List(s, 3) = Sheets(i).Cells(sat, "e")
ListBox1.List(s, 4) = Sheets(i).Cells(sat, "bf")
ListBox1.List(s, 5) = Sheets(i).Cells(sat, "g")
ListBox1.List(s, 6) = Sheets(i).Cells(sat, "h")
ListBox1.List(s, 7) = Sheets(i).Cells(sat, "ı")
s = s + 1
End If: Next: Next
End Sub
Private Sub UserForm_Initialize()
Dim i, sat As Integer
For i = 2 To Sheets.Count
For sat = 3 To Sheets(i).Cells(65536, "b").End(xlUp).Row
Sheets(i).Range("b3:I" & sat).Sort key1:=Sheets(i).[b3], order1:=xlAscending
Next: Next
TextBox1 = ".": TextBox1 = ""
End Sub

 

[mami67]

Sn.Hiçdurmaz,
ilginize çok teşekkür ederim aslında tam istediğim gibi eğer abartmış olmaz isem sizden biraz düzeltmeler isteyebilirmiyim
mesala text kutusunu ben biraz büyüttüm yazı fontlarınıda büyüttüm fakat isimler bazan uzun olduğunda tam okunmuyor kutu içerisndeki yazı karakter adetlerini uzatabilirmiyiz.
birde excel deki sütun lar gibi sütun kunulabilirmi kutu içerisine biraz fazla oldum biliyorum seçtiğim kişiyi tıkladığımda o hücreye gidebilirmiyim diğerleri olursa bu çok önemli değil

ama cevap verip bunu bile yapmanız çok büyük bir incelik çok teşekkür ederim elinize ve yüreğinize sağlık
Esen kalın

 

[arifaksamc]

Sayın "N.Ziya Hiçdurmaz" mami67 arkadaşımızın sorusuna ek olarak, bu telefon defterinin indeks sayfasına arama butonunun altına "Kişi Ekleme" butonu ekleyebilir miyiz? Böylece genel olarak kullanılabilecek kullanışlı bir telefon defteri elde etmiş oluruz gibi geliyor bana Şimdiden teşekkürler...

 

[mami67]

Sayın arifaksamc,
forumda çok kapsamlı telefon adres listeleri mevcut arama yaptırıp bulabilirsiniz istediğinize uygun olabiliceğini düşünüyorum ben daha sade ve kullanışlı olmasını istediğim için bunun üzerine gidiyorum

esen kalın

 

[arifaksamc]

Sayın mami67,

Ben özellikle "Kişi Ekleme" gibi bir butonu diğer uygulamalar içinde kullanabilmek adına, ayrıca yeni birşeyler öğrenebilmek için sordum. Tabi ki sizin emek verdiğiniz, ustalarımızında katkı yaptığı "Telefon Defteri"ni de kullanabiliriz

 

[mami67]

Sayın mami67,

Ben özellikle "Kişi Ekleme" gibi bir butonu diğer uygulamalar içinde kullanabilmek adına, ayrıca yeni birşeyler öğrenebilmek için sordum. Tabi ki sizin emek verdiğiniz, ustalarımızında katkı yaptığı "Telefon Defteri"ni de kullanabiliriz

yanlış anlamayın lütfen forumda inanın müthiş örnekler var meraklısına size tavsiyem önce istediğiniz veya yapacağınız çalışmayı kafanızda bitirin ona uygun yaklaşık kesin bir örnek vardır. çünkü insan ne istedğini bilmeyince kafası karışıyo ben çok şey öğrendim şimdi ne istediğimi biliyorum sağolsun uzman arkadaşların yardımı ile istediğim programı yapabiliyorum.

esen kalın

 

[arifaksamc]

Neden yanlış anlayayım, hepimizin amacı yeni bişeyler öğrenmek esen kalın

 

[N.Ziya Hiçdurmaz]

yanıt

Private Sub CommandButton1_Click()
Sheets("Endeks").Select
End Sub
Private Sub ListBox1_Click()
For i = 2 To Sheets.Count
For sat = 3 To Sheets(i).Cells(65536, "c").End(xlUp).Row
If ListBox1.Column(1) Like Sheets(i).Cells(sat, "c") Then
Sheets(i).Select
Cells(sat, "c").Select
End If: Next: Next
End Sub
Private Sub TextBox1_Change()
Dim i, sat, s As Integer
ListBox1.Clear
ListBox1.ColumnCount = 8
For i = 2 To Sheets.Count
For sat = 3 To Sheets(i).Cells(65536, "b").End(xlUp).Row
If Sheets(i).Cells(sat, "b") Like TextBox1 & "*" Then
ListBox1.AddItem
ListBox1.List(s, 0) = Sheets(i).Cells(sat, "b")
ListBox1.List(s, 1) = Sheets(i).Cells(sat, "c")
ListBox1.List(s, 2) = Sheets(i).Cells(sat, "d")
ListBox1.List(s, 3) = Sheets(i).Cells(sat, "e")
ListBox1.List(s, 4) = Sheets(i).Cells(sat, "f")
ListBox1.List(s, 5) = Sheets(i).Cells(sat, "g")
ListBox1.List(s, 6) = Sheets(i).Cells(sat, "h")
ListBox1.List(s, 7) = Sheets(i).Cells(sat, "ı")
s = s + 1
End If: Next: Next
TextBox1.Width = Len(TextBox1) + 110
End Sub
Private Sub TextBox2_Change()
Dim i, sat, s As Integer
ListBox1.Clear
ListBox1.ColumnCount = 8
For i = 2 To Sheets.Count
For sat = 3 To Sheets(i).Cells(65536, "c").End(xlUp).Row
If Sheets(i).Cells(sat, "c") Like TextBox2 & "*" Then
ListBox1.AddItem
ListBox1.List(s, 0) = Sheets(i).Cells(sat, "b")
ListBox1.List(s, 1) = Sheets(i).Cells(sat, "c")
ListBox1.List(s, 2) = Sheets(i).Cells(sat, "d")
ListBox1.List(s, 3) = Sheets(i).Cells(sat, "e")
ListBox1.List(s, 4) = Sheets(i).Cells(sat, "f")
ListBox1.List(s, 5) = Sheets(i).Cells(sat, "g")
ListBox1.List(s, 6) = Sheets(i).Cells(sat, "h")
ListBox1.List(s, 7) = Sheets(i).Cells(sat, "ı")
s = s + 1
End If: Next: Next
TextBox2.Width = Len(TextBox2) + 110
End Sub
Private Sub UserForm_Initialize()
Dim i, sat As Integer
For i = 2 To Sheets.Count
For sat = 3 To Sheets(i).Cells(65536, "b").End(xlUp).Row
Sheets(i).Range("b3:I" & sat).Sort key1:=Sheets(i).[b3], order1:=xlAscending
Next: Next
TextBox1 = ".": TextBox1 = ""
End Sub

 

[mami67]

Sayın Hiçdurmaz,
Çok mütevazi ve bir o kadarda süpersiniz bu son istediğimdi çok güzel olmuş ki bir öncekini kullanmaya başladım ve işede yaradı elinize ve emeğinize sağlık çok teşekkürler. yanlız bir ricam daha oalcak butonu tıkladığımda ve isim yazarken ve arama yaparken kasma yapıyor. tabi bütün sayfalar en az 30 satı dolu olarak düşünün hız için birşey yapabiliyormuyuz

esen kalın

 

[N.Ziya Hiçdurmaz]

yanıt

Bir miktar hız kazandı.

 

[mami67]

Sayın Hiçdurmaz,
Çok teşekkürler emeğinizi ve zamanınızı ayırdınız çok sağolun

esen kalın

 

[N.Ziya Hiçdurmaz]

Birşey değil.Sayın mami67

 

[topaloglu05]

Emeğinize Sağlık
işime yarayacak güzel bir örnek

 

[_SıLa_]

slm,tşkkr ederm