Yazdığım harflerle başlayan....

A

adokskel

Katılım
25 Haziran 2009
Mesajlar
87
Excel Vers. ve Dili
Excel 2007 Türkçe
Günaydın

Yazdığım harlflerle başlayan, daha önce başka bir excel dosyasındaki müşterilerin ekrana gelmesi, mümkün mü. Ekdeki dosyalarda tam olarak demek istediğimi şekillerle anlattım.

Vakit ayırıp okuduğunuz için teşekkür ederim.
 

Ekli dosyalar

Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,248
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Dosyanız ektedir.
2 dosyanında ayni klasör içinde olması lazım.:cool:
Kod: 
Private Sub TextBox1_Change()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Range("A2:E65536").ClearContents
conn.Open "Provider=microsoft.jet.oledb.4.0;Data source=" & ThisWorkbook.Path & "\Data.xls;extended properties=""excel 8.0;hdr=yes;"""
rs.Open "Select * from [Sayfa1$] where Musteri like '" & TextBox1.Text & "%';", conn, adOpenDynamic, adLockOptimistic
Range("C2").CopyFromRecordset rs
rs.Close
conn.Close
Set conn = Nothing
Set rs = Nothing
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("A2:E" & Cells(65536, "C").End(xlUp).Row)) Is Nothing Then Exit Sub
Range("A2:E2").Value = Range("A" & Target.Row & ":E" & Target.Row).Value
Range("A3:E65536").ClearContents
Cancel = True
End Sub
 

Ekli dosyalar

A

adokskel

Katılım
25 Haziran 2009
Mesajlar
87
Excel Vers. ve Dili
Excel 2007 Türkçe
Evren bey mükemmel olmuş. ellerinize sağlık. Çok teşekkür ederim. Büyük-küçük harf duyarlılığını iptal etmek mümkün mü, ya da data.xls dosyamdaki bütün bilgileri büyük harfe çevirmem mümkün mü tek tek uğraşmadan?
 
T

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,167
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Sn. Evren hocam, güzel olmuş elinize sağlık, ben kodlar için denedim, yani müşteri ismi yerinde rakamsal değerler olduğunda listeleme yapmıyor neden olabilir.
 
T

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,167
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Sn. Adokskel Dünüştürmek istediğiniz sutun veya hücreyi seçin, aşağıdaki makroyu çalıştırınız.

Sub BüyükHarfeÇevir()
Selection.Replace What:="a", Replacement:="A"
Selection.Replace What:="b", Replacement:="B"
Selection.Replace What:="c", Replacement:="C"
Selection.Replace What:="ç", Replacement:="Ç"
Selection.Replace What:="d", Replacement:="D"
Selection.Replace What:="e", Replacement:="E"
Selection.Replace What:="f", Replacement:="F"
Selection.Replace What:="g", Replacement:="G"
Selection.Replace What:="ğ", Replacement:="Ğ"
Selection.Replace What:="h", Replacement:="H"
Selection.Replace What:="ı", Replacement:="I"
Selection.Replace What:="i", Replacement:="İ"
Selection.Replace What:="j", Replacement:="J"
Selection.Replace What:="k", Replacement:="K"
Selection.Replace What:="l", Replacement:="L"
Selection.Replace What:="m", Replacement:="M"
Selection.Replace What:="n", Replacement:="N"
Selection.Replace What:="o", Replacement:="O"
Selection.Replace What:="ö", Replacement:="Ö–"
Selection.Replace What:="p", Replacement:="P"
Selection.Replace What:="r", Replacement:="R"
Selection.Replace What:="s", Replacement:="S"
Selection.Replace What:="ş", Replacement:="Ş"
Selection.Replace What:="t", Replacement:="T"
Selection.Replace What:="u", Replacement:="U"
Selection.Replace What:="ü", Replacement:="Ü"
Selection.Replace What:="v", Replacement:="V"
Selection.Replace What:="y", Replacement:="Y"
Selection.Replace What:="z", Replacement:="Z"
Selection.Replace What:="q", Replacement:="Q"
Selection.Replace What:="w", Replacement:="W"
Selection.Replace What:="x", Replacement:="X"
End Sub
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,248
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Zaten büyük küçük harfe duyarlı değil.
Siz İ ile arama yapıyorsanız sadece bunu için sorun oluşur.Çünkü ingilizcede böyle bir karakter yok.Veri tabanlarında bu sorun çıkarıyor.:cool:
 
A

adokskel

Katılım
25 Haziran 2009
Mesajlar
87
Excel Vers. ve Dili
Excel 2007 Türkçe
Evet "İ" ile arama yapmıştım.
Uzman olamayıp da kimseye yardım edememenin verdiği eziklik ile hep yardım isteyen biri olarak tekrar çok teşekkür ederim.
her işiniz rast gitsin, kolay gelsin
 
T

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,167
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Sn. Evren Hocam, müşteri isimlerinin numerik olduğunu var sayarsak, kodda nasıl bir düzenleme yapmalıyız, bakabilirseniz sevinirim. örnek 1238228 gibi bir müşteri ismi olsun, bunu çağırdığımızda listelenmiyor. Stok kodlarım için kullanmayı düşündüm. Teşkekkürler.
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,248
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
tahsinanarat' Alıntı:
Sn. Evren Hocam, müşteri isimlerinin numerik olduğunu var sayarsak, kodda nasıl bir düzenleme yapmalıyız, bakabilirseniz sevinirim. örnek 1238228 gibi bir müşteri ismi olsun, bunu çağırdığımızda listelenmiyor. Stok kodlarım için kullanmayı düşündüm. Teşkekkürler.
Genişletmek için tıkla ...
:cool:
Kod: 
Private Sub TextBox1_Change()
On Error Resume Next
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Range("A2:E65536").ClearContents
conn.Open "Provider=microsoft.jet.oledb.4.0;Data source=" & ThisWorkbook.Path & "\Data.xls;extended properties=""excel 8.0;hdr=yes;"""
rs.Open "Select * from [Sayfa1$] where Musteri =" & CDbl(Sheets("Sayfa1").TextBox1.Text) & ";", conn, adOpenDynamic, adLockOptimistic
Range("C2").CopyFromRecordset rs
rs.Close
conn.Close
Set conn = Nothing
Set rs = Nothing
End Sub
 
T

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,167
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Evren Hocam ilginize çok teşekkür ederim, ancak çalıştıramıdm, kodları denemişmiydiniz.
 
E

egon77

Katılım
19 Şubat 2009
Mesajlar
19
Excel Vers. ve Dili
excel2003
Evren Gizlen' Alıntı:
Dosyanız ektedir.
2 dosyanında ayni klasör içinde olması lazım.:cool:
Kod: 
Private Sub TextBox1_Change()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Range("A2:E65536").ClearContents
conn.Open "Provider=microsoft.jet.oledb.4.0;Data source=" & ThisWorkbook.Path & "\Data.xls;extended properties=""excel 8.0;hdr=yes;"""
rs.Open "Select * from [Sayfa1$] where Musteri like '" & TextBox1.Text & "%';", conn, adOpenDynamic, adLockOptimistic
Range("C2").CopyFromRecordset rs
rs.Close
conn.Close
Set conn = Nothing
Set rs = Nothing
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("A2:E" & Cells(65536, "C").End(xlUp).Row)) Is Nothing Then Exit Sub
Range("A2:E2").Value = Range("A" & Target.Row & ":E" & Target.Row).Value
Range("A3:E65536").ClearContents
Cancel = True
End Sub
Genişletmek için tıkla ...
Merhaba,

Yukarıdaki örneği kendi çalışmamda uygulamak istedim fakat bir çok kez denediğim halde başaramadım(sürekli conn bağlantı hatası- hücrelerin yerini kodlarda değiştirdiğim halde). Ek' te dosyayı ve müşteri isminin geleceği yeri işaretledim. İlgilerinize şimdiden teşekkür ederim.
 

Ekli dosyalar

  • ftt.zip
    186.7 KB Görüntüleme: 15
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,248
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
egon77' Alıntı:
Merhaba,

Yukarıdaki örneği kendi çalışmamda uygulamak istedim fakat bir çok kez denediğim halde başaramadım(sürekli conn bağlantı hatası- hücrelerin yerini kodlarda değiştirdiğim halde). Ek' te dosyayı ve müşteri isminin geleceği yeri işaretledim. İlgilerinize şimdiden teşekkür ederim.
Genişletmek için tıkla ...
Referanslardan Microsoft activex data object 2.x library seçili olmalı.
Dosyanız ekte.:cool:
Kod: 
Sub aktar()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Range("C8").Value = ""
Set conn = New ADODB.Connection
conn.Open "Provider=Microsoft.jet.oledb.4.0;Data Source=" & ThisWorkbook.Path _
& "\Data.xls;extended properties=""excel 8.0;hdr=yes;"""
Set rs = New ADODB.Recordset
Set rs = conn.Execute("Select top 1 * from [Sheet1$] where Musteri like'" & _
Sheets("FTT").TextBox1.Text & "%';")
Range("C8").CopyFromRecordset rs
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
End Sub
 

Ekli dosyalar

T

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,167
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Sn. Evren Hocam, size çok zahmet verdik, ilgi ve alakanıza çok teşekkür ediyorum, sağolun varolun. 2.mesajınızdaki dosyanın işlevine hayran kalmıştım doğrusu, yani kutucuğa yazdıkca filtrelenmesi daha hoştu. Saygılar sunuyorum.
Not: daha sonra dikkatimi çekti hocam, bire bir eşleştiklerini getiriyor.
 
Son düzenleme:
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,248
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
tahsinanarat' Alıntı:
Sn. Evren Hocam, size çok zahmet verdik, ilgi ve alakanıza çok teşekkür ediyorum, sağolun varolun. 2.mesajınızdaki dosyanın işlevine hayran kalmıştım doğrusu, yani kutucuğa yazdıkca filtrelenmesi daha hoştu. Saygılar sunuyorum.
Genişletmek için tıkla ...
Orada like kullandık ve başlar kullnadık.Bu özelliği string ve metin verileri için kullanabiliyoruz.Siz nümeric için istediniz .Numeric değerler için başlar ve içerir kullanamıyoruz.Sanırım like ta kullanılamıyor.O yüzden o şekli ile idare edeceksiniz.:cool.
 
E

egon77

Katılım
19 Şubat 2009
Mesajlar
19
Excel Vers. ve Dili
excel2003
Evren Gizlen' Alıntı:
Referanslardan Microsoft activex data object 2.x library seçili olmalı.
Dosyanız ekte.:cool:
Kod: 
Sub aktar()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Range("D8:D10").ClearContents
Set conn = New ADODB.Connection
conn.Open "Provider=Microsoft.jet.oledb.4.0;Data Source=" & ThisWorkbook.Path _
& "\Data.xls;extended properties=""excel 8.0;hdr=yes;"""
Set rs = New ADODB.Recordset
rs.Open "Select * from [Sheet1$];", conn, adOpenDynamic, adLockOptimistic
Range("D8").CopyFromRecordset rs
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
MsgBox "Veriler D sütununa aktarıldı", vbOKOnly, "E V R E N"
End Sub
Genişletmek için tıkla ...
Evren Hocam teşekkürlerimi ve saygılarımı sunuyorum önce size.
Sonrada özür dileyerek örnek dosyada benim eksik bilgi vermemin neticesi
olan durumu düzeltmenizi rica edeceğim. Ben örnekteki textbox un içine veri girdiğimde data dan verileri süzmesini istemiştim. Yani textbox a harf girdiğimde datadan tek olan firma bilgisi sarı alana gelecek. Bu başlıkta verilen ilk örnek gibi.
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,248
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
egon77' Alıntı:
Evren Hocam teşekkürlerimi ve saygılarımı sunuyorum önce size.
Sonrada özür dileyerek örnek dosyada benim eksik bilgi vermemin neticesi
olan durumu düzeltmenizi rica edeceğim. Ben örnekteki textbox un içine veri girdiğimde data dan verileri süzmesini istemiştim. Yani textbox a harf girdiğimde datadan tek olan firma bilgisi sarı alana gelecek. Bu başlıkta verilen ilk örnek gibi.
Genişletmek için tıkla ...
13 numaralı mesajda dosyanız hazır.:cool:
 
E

egon77

Katılım
19 Şubat 2009
Mesajlar
19
Excel Vers. ve Dili
excel2003
Private Sub TextBox1_Change()
Call aktar
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("c8:I12").End(xlUp).Row) Is Nothing Then Exit Sub
Range("c8:I12").Value = Range("c" & Target.Row & ":I" & Target.Row).Value
Range("c8:I12").ClearContents
Cancel = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

Günaydın Evren Bey,

Yukarda hazırladığını kodları kendimce düzenlemeye çalıştım fakat texbox a veri girdiğim zaman c sütunun altına diğer müşteri isimlerinin gelmemesini engelleyemiyorum. Eğer sadece c8:I12 hücresine tek müşteri gelirse kod tamam olacak.
Saygılarımla

Sub aktar()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Range("C8").Value = ""
Set conn = New ADODB.Connection
conn.Open "Provider=Microsoft.jet.oledb.4.0;Data Source=" & ThisWorkbook.Path _
& "\Data.xls;extended properties=""excel 8.0;hdr=yes;"""
Set rs = New ADODB.Recordset
rs.Open "Select * from [Sheet1$] where Musteri like'" & _
Sheets("FTT").TextBox1.Text & "%';", conn, adOpenDynamic, adLockOptimistic
Range("C8").CopyFromRecordset rs
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
End Sub

aslında bu kodda da var bir şeyler ama çözemedim:)
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,248
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
İstediğinizi yaptım.13 numaralaı mesajdan dosyayı indirebilirsiniz.:cool:
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst