• DİKKAT

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

arama yı buyuk kucuk harf duyarlı yapmasın

M

melih3365

Katılım
29 Temmuz 2008
Mesajlar
9
Excel Vers. ve Dili
2003 türkçe
merhaba arkadaslar programlamadan hıc anlamam bı kac kod buldum kendımce bı rehber duzenlıyorum arama butonuna tıklayınca buyuk kucuk harf duyarlı arama yapıyor nasıl düzenlerım.
text e bunları
Kod: 
Private Sub bul_Click()
Dim say, adet, miktar As Integer
Dim sonuc As String
Dim hucre, hcr As Range

If OptionButton1.Value = True Then
If bultxt.Value = Empty Then
MsgBox "Aradığınız kaydın ismini veya ilk harflerini girmelisiniz!..", vbInformation, "Telefon Rehberi"
bultxt.SetFocus
Exit Sub
Else
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).ClearContents
say = Len(bultxt.Value)
sonuc = Left(bultxt.Value, say)
For Each hucre In Range(Range("B3"), Range("B" & Sayfa1.[A1].Value + 2))
If sonuc = Left(hucre, say) Then
hucre.Offset(0, 7).Value = hucre.Value
End If
Next
analist.Clear
For Each hcr In Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2))
If hcr.Value <> "" Then analist.AddItem hcr
Next
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).Select
miktar = Application.CountA(Selection)
Label9.Caption = "Aranan kriterde " & miktar & " kayıt bulundu"
If miktar = 0 Then
MsgBox bultxt.Value & " ile başlayan kayıt bulunamadı.", vbInformation, "Telefon Rehberi"
analist.Clear
For Each hucre In Range(Range("B3"), Range("B" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
Label9.Caption = "Telefon Rehberi Tüm İsim Listesi"
bultxt.SetFocus
End If
End If
End If

If OptionButton2.Value = True Then
If bultxt.Value = Empty Then
MsgBox "Aradığınız kaydın telefon numarasını veya ilk rakamlarını girmelisiniz!..", vbInformation, "Telefon Rehberi"
bultxt.SetFocus
Exit Sub
Else
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).ClearContents
say = Len(bultxt.Value)
sonuc = Left(bultxt.Value, say)
For Each hucre In Range(Range("C3"), Range("C" & Sayfa1.[A1].Value + 2))
If sonuc = Left(hucre, say) Then
hucre.Offset(0, 6).Value = hucre.Value
End If
Next
analist.Clear
For Each hcr In Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2))
If hcr.Value <> "" Then analist.AddItem hcr
Next
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).Select
miktar = Application.CountA(Selection)
Label9.Caption = "Aranan kriterde " & miktar & " kayıt bulundu"
If miktar = 0 Then
MsgBox bultxt.Value & " ile başlayan kayıt bulunamadı.", vbInformation, "Telefon Rehberi"
analist.Clear
For Each hucre In Range(Range("C3"), Range("C" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
Label9.Caption = "Telefon Rehberi Tüm Telefon Numarası - 1 Kayıtları"
bultxt.SetFocus
End If
End If
End If

If OptionButton3.Value = True Then
If bultxt.Value = Empty Then
MsgBox "Aradığınız kaydın telefon numarasını veya ilk rakamlarını girmelisiniz!..", vbInformation, "Telefon Rehberi"
bultxt.SetFocus
Exit Sub
Else
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).ClearContents
say = Len(bultxt.Value)
sonuc = Left(bultxt.Value, say)
For Each hucre In Range(Range("D3"), Range("D" & Sayfa1.[A1].Value + 2))
If sonuc = Left(hucre, say) Then
hucre.Offset(0, 5).Value = hucre.Value
End If
Next
analist.Clear
For Each hcr In Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2))
If hcr.Value <> "" Then analist.AddItem hcr
Next
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).Select
miktar = Application.CountA(Selection)
Label9.Caption = "Aranan kriterde " & miktar & " kayıt bulundu"
If miktar = 0 Then
MsgBox bultxt.Value & " ile başlayan kayıt bulunamadı.", vbInformation, "Telefon Rehberi"
analist.Clear
For Each hucre In Range(Range("D3"), Range("D" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
Label9.Caption = "Telefon Rehberi Tüm Telefon Numarası - 2 Kayıtları"
bultxt.SetFocus
End If
End If
End If

If OptionButton4.Value = True Then
If bultxt.Value = Empty Then
MsgBox "Aradığınız kaydın telefon numarasını veya ilk rakamlarını girmelisiniz!..", vbInformation, "Telefon Rehberi"
bultxt.SetFocus
Exit Sub
Else
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).ClearContents
say = Len(bultxt.Value)
sonuc = Left(bultxt.Value, say)
For Each hucre In Range(Range("E3"), Range("E" & Sayfa1.[A1].Value + 2))
If sonuc = Left(hucre, say) Then
hucre.Offset(0, 4).Value = hucre.Value
End If
Next
analist.Clear
For Each hcr In Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2))
If hcr.Value <> "" Then analist.AddItem hcr
Next
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).Select
miktar = Application.CountA(Selection)
Label9.Caption = "Aranan kriterde " & miktar & " kayıt bulundu"
If miktar = 0 Then
MsgBox bultxt.Value & " ile başlayan kayıt bulunamadı.", vbInformation, "Telefon Rehberi"
analist.Clear
For Each hucre In Range(Range("E3"), Range("E" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
Label9.Caption = "Telefon Rehberi Tüm Dahili Numaralar Listesi"
bultxt.SetFocus
End If
End If
End If

If OptionButton5.Value = True Then
If bultxt.Value = Empty Then
MsgBox "Aradığınız kaydın telefon numarasını veya ilk rakamlarını girmelisiniz!..", vbInformation, "Telefon Rehberi"
bultxt.SetFocus
Exit Sub
Else
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).ClearContents
say = Len(bultxt.Value)
sonuc = Left(bultxt.Value, say)
For Each hucre In Range(Range("F3"), Range("F" & Sayfa1.[A1].Value + 2))
If sonuc = Left(hucre, say) Then
hucre.Offset(0, 3).Value = hucre.Value
End If
Next
analist.Clear
For Each hcr In Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2))
If hcr.Value <> "" Then analist.AddItem hcr
Next
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).Select
miktar = Application.CountA(Selection)
Label9.Caption = "Aranan kriterde " & miktar & " kayıt bulundu"
If miktar = 0 Then
MsgBox bultxt.Value & " ile başlayan kayıt bulunamadı.", vbInformation, "Telefon Rehberi"
analist.Clear
For Each hucre In Range(Range("F3"), Range("F" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
Label9.Caption = "Telefon Rehberi Tüm Faks Numaraları Listesi"
bultxt.SetFocus
End If
End If
End If

If OptionButton6.Value = True Then
If bultxt.Value = Empty Then
MsgBox "Aradığınız kaydın telefon numarasını veya ilk rakamlarını girmelisiniz!..", vbInformation, "Telefon Rehberi"
bultxt.SetFocus
Exit Sub
Else
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).ClearContents
say = Len(bultxt.Value)
sonuc = Left(bultxt.Value, say)
For Each hucre In Range(Range("G3"), Range("G" & Sayfa1.[A1].Value + 2))
If sonuc = Left(hucre, say) Then
hucre.Offset(0, 2).Value = hucre.Value
End If
Next
analist.Clear
For Each hcr In Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2))
If hcr.Value <> "" Then analist.AddItem hcr
Next
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).Select
miktar = Application.CountA(Selection)
Label9.Caption = "Aranan kriterde " & miktar & " kayıt bulundu"
If miktar = 0 Then
MsgBox bultxt.Value & " ile başlayan kayıt bulunamadı.", vbInformation, "Telefon Rehberi"
analist.Clear
For Each hucre In Range(Range("G3"), Range("G" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
Label9.Caption = "Telefon Rehberi Tüm Cep Telefonu Kayıtları"
bultxt.SetFocus
End If
End If
End If

bultxt.SetFocus
End Sub

arama butonda bu kodlar var 

Private Sub bul_Click()
Dim say, adet, miktar As Integer
Dim sonuc As String
Dim hucre, hcr As Range

If OptionButton1.Value = True Then
If bultxt.Value = Empty Then
MsgBox "Aradığınız kaydın ismini veya ilk harflerini girmelisiniz!..", vbInformation, "Telefon Rehberi"
bultxt.SetFocus
Exit Sub
Else
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).ClearContents
say = Len(bultxt.Value)
sonuc = Left(bultxt.Value, say)
For Each hucre In Range(Range("B3"), Range("B" & Sayfa1.[A1].Value + 2))
If sonuc = Left(hucre, say) Then
hucre.Offset(0, 7).Value = hucre.Value
End If
Next
analist.Clear
For Each hcr In Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2))
If hcr.Value <> "" Then analist.AddItem hcr
Next
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).Select
miktar = Application.CountA(Selection)
Label9.Caption = "Aranan kriterde " & miktar & " kayıt bulundu"
If miktar = 0 Then
MsgBox bultxt.Value & " ile başlayan kayıt bulunamadı.", vbInformation, "Telefon Rehberi"
analist.Clear
For Each hucre In Range(Range("B3"), Range("B" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
Label9.Caption = "Telefon Rehberi Tüm İsim Listesi"
bultxt.SetFocus
End If
End If
End If

If OptionButton2.Value = True Then
If bultxt.Value = Empty Then
MsgBox "Aradığınız kaydın telefon numarasını veya ilk rakamlarını girmelisiniz!..", vbInformation, "Telefon Rehberi"
bultxt.SetFocus
Exit Sub
Else
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).ClearContents
say = Len(bultxt.Value)
sonuc = Left(bultxt.Value, say)
For Each hucre In Range(Range("C3"), Range("C" & Sayfa1.[A1].Value + 2))
If sonuc = Left(hucre, say) Then
hucre.Offset(0, 6).Value = hucre.Value
End If
Next
analist.Clear
For Each hcr In Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2))
If hcr.Value <> "" Then analist.AddItem hcr
Next
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).Select
miktar = Application.CountA(Selection)
Label9.Caption = "Aranan kriterde " & miktar & " kayıt bulundu"
If miktar = 0 Then
MsgBox bultxt.Value & " ile başlayan kayıt bulunamadı.", vbInformation, "Telefon Rehberi"
analist.Clear
For Each hucre In Range(Range("C3"), Range("C" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
Label9.Caption = "Telefon Rehberi Tüm Telefon Numarası - 1 Kayıtları"
bultxt.SetFocus
End If
End If
End If

If OptionButton3.Value = True Then
If bultxt.Value = Empty Then
MsgBox "Aradığınız kaydın telefon numarasını veya ilk rakamlarını girmelisiniz!..", vbInformation, "Telefon Rehberi"
bultxt.SetFocus
Exit Sub
Else
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).ClearContents
say = Len(bultxt.Value)
sonuc = Left(bultxt.Value, say)
For Each hucre In Range(Range("D3"), Range("D" & Sayfa1.[A1].Value + 2))
If sonuc = Left(hucre, say) Then
hucre.Offset(0, 5).Value = hucre.Value
End If
Next
analist.Clear
For Each hcr In Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2))
If hcr.Value <> "" Then analist.AddItem hcr
Next
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).Select
miktar = Application.CountA(Selection)
Label9.Caption = "Aranan kriterde " & miktar & " kayıt bulundu"
If miktar = 0 Then
MsgBox bultxt.Value & " ile başlayan kayıt bulunamadı.", vbInformation, "Telefon Rehberi"
analist.Clear
For Each hucre In Range(Range("D3"), Range("D" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
Label9.Caption = "Telefon Rehberi Tüm Telefon Numarası - 2 Kayıtları"
bultxt.SetFocus
End If
End If
End If

If OptionButton4.Value = True Then
If bultxt.Value = Empty Then
MsgBox "Aradığınız kaydın telefon numarasını veya ilk rakamlarını girmelisiniz!..", vbInformation, "Telefon Rehberi"
bultxt.SetFocus
Exit Sub
Else
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).ClearContents
say = Len(bultxt.Value)
sonuc = Left(bultxt.Value, say)
For Each hucre In Range(Range("E3"), Range("E" & Sayfa1.[A1].Value + 2))
If sonuc = Left(hucre, say) Then
hucre.Offset(0, 4).Value = hucre.Value
End If
Next
analist.Clear
For Each hcr In Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2))
If hcr.Value <> "" Then analist.AddItem hcr
Next
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).Select
miktar = Application.CountA(Selection)
Label9.Caption = "Aranan kriterde " & miktar & " kayıt bulundu"
If miktar = 0 Then
MsgBox bultxt.Value & " ile başlayan kayıt bulunamadı.", vbInformation, "Telefon Rehberi"
analist.Clear
For Each hucre In Range(Range("E3"), Range("E" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
Label9.Caption = "Telefon Rehberi Tüm Dahili Numaralar Listesi"
bultxt.SetFocus
End If
End If
End If

If OptionButton5.Value = True Then
If bultxt.Value = Empty Then
MsgBox "Aradığınız kaydın telefon numarasını veya ilk rakamlarını girmelisiniz!..", vbInformation, "Telefon Rehberi"
bultxt.SetFocus
Exit Sub
Else
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).ClearContents
say = Len(bultxt.Value)
sonuc = Left(bultxt.Value, say)
For Each hucre In Range(Range("F3"), Range("F" & Sayfa1.[A1].Value + 2))
If sonuc = Left(hucre, say) Then
hucre.Offset(0, 3).Value = hucre.Value
End If
Next
analist.Clear
For Each hcr In Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2))
If hcr.Value <> "" Then analist.AddItem hcr
Next
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).Select
miktar = Application.CountA(Selection)
Label9.Caption = "Aranan kriterde " & miktar & " kayıt bulundu"
If miktar = 0 Then
MsgBox bultxt.Value & " ile başlayan kayıt bulunamadı.", vbInformation, "Telefon Rehberi"
analist.Clear
For Each hucre In Range(Range("F3"), Range("F" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
Label9.Caption = "Telefon Rehberi Tüm Faks Numaraları Listesi"
bultxt.SetFocus
End If
End If
End If

If OptionButton6.Value = True Then
If bultxt.Value = Empty Then
MsgBox "Aradığınız kaydın telefon numarasını veya ilk rakamlarını girmelisiniz!..", vbInformation, "Telefon Rehberi"
bultxt.SetFocus
Exit Sub
Else
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).ClearContents
say = Len(bultxt.Value)
sonuc = Left(bultxt.Value, say)
For Each hucre In Range(Range("G3"), Range("G" & Sayfa1.[A1].Value + 2))
If sonuc = Left(hucre, say) Then
hucre.Offset(0, 2).Value = hucre.Value
End If
Next
analist.Clear
For Each hcr In Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2))
If hcr.Value <> "" Then analist.AddItem hcr
Next
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).Select
miktar = Application.CountA(Selection)
Label9.Caption = "Aranan kriterde " & miktar & " kayıt bulundu"
If miktar = 0 Then
MsgBox bultxt.Value & " ile başlayan kayıt bulunamadı.", vbInformation, "Telefon Rehberi"
analist.Clear
For Each hucre In Range(Range("G3"), Range("G" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
Label9.Caption = "Telefon Rehberi Tüm Cep Telefonu Kayıtları"
bultxt.SetFocus
End If
End If
End If

bultxt.SetFocus
End Sub
 
Son düzenleme:
Merhaba,

İlk olarak bir uyarıda bulunmak istiyorum. Foruma eklediğiniz kodları [ code ] [ / code ] tagları arasına eklerseniz daha düzenli ve okunaklı görünecektir. Bu tagı mesaj yazdığınız pencerede "#" sembolüne tıklayarak oluşturabilirsiniz.

Gelelim sorunuzun cevabına;

Arama işlemlerinde direk aranan veriyi arama alanında eşleştirirseniz büyük-küçük harf duyarlı arama yapmış olursunuz. Bu sebeple kıyaslanan veriler komple büyük harfe çevrilerek sorgulanırsa bu sorun ortadan kalkar. Verdiğiniz kodu uygun bölümüne aşağıdaki sorguyu uygulamalısınız.

Kod: 
If Ucase(Replace(Replace(Bul.Value, "i", "İ"), "ı", "I")) = Ucase(Replace(Replace(Range("A1"), "i", "İ"), "ı", "I")) Then

Bu kod satırındaki ifadeler örnektir. Kendinize uyarlamanız gerekiyor.
 
Kod: 
If Ucase(Replace(Replace(Bul.Value, "i", "İ"), "ı", "I")) = Ucase(Replace(Replace(Range("A1"), "i", "İ"), "ı", "I")) Then

Bu kod satırındaki ifadeler örnektir. Kendinize uyarlamanız gerekiyor.[/QUOTE]

pekı korhan bey bı sorum daha var aramayı bırden cok sutunda yaptırmak ıstersek misal a b c sutununda ne yapmak gerekır
 
Arama işleminde kullandığınız döngünüzdeki hücre aralığını genişleterek çoklu sütunda arama yapabilirsiniz.

Örnek döngü;

Kod: 
For Each Veri In Range("A1:Z100")
   'Arama sorgu kodlarınız...
   'Arama sorgu kodlarınız...
   'Arama sorgu kodlarınız...
Next
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst