• DİKKAT

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

Otomatik Tamamlama

Katılım
30 Ağustos 2005
Mesajlar
30
Arkadaşlar iyi bayramlar,

http://www.excel.web.tr/showthread.php?t=87555&highlight=otomatik+tamamlama

Adresinden aldığım örnek çalışmayı biraz kendime göre uyarladım ancak otomatik tamamlamayı 20. satırdan sonra yapmıyor. Örnek dosya ektedir.

B21'e 65 yazın 2. sayfadaki 65'i yazması gerekli ancak yukarda yaptığı işlemi 20. satırdan sonra yapmıyor.

Bunu nasıl çözebilirim?
 

Ekli dosyalar

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not UserForm1.ListBox1.Tag = "off" Then
If Intersect(Target, Range("[COLOR="Red"]b5:b65535[/COLOR]")) Is Nothing Then Exit Sub
Dim deger As Range
sayac = 0
derlenen = Target.Address

bakilan = UCase(Replace(Replace(Target.Value, "i", "İ"), "ı", "I"))


For Each deger In Sheets("Sayfa2").Range("g5:g85")

If Not IsEmpty(deger.Value) And Left(deger.Value, Len(bakilan)) = bakilan Then

    sayac = sayac + 1
    sonuc = deger.Value
    
    If sayac = 1 Then
    UserForm1.ListBox1.Clear
    End If
    
    UserForm1.ListBox1.AddItem deger.Value

End If

Next


If sayac > 1 Then
UserForm1.Tag = derlenen
UserForm1.Caption = "Birden Cok Uygun Kayit Var, Lutfen Birini Seciniz"
UserForm1.ListBox1.Tag = "off"

UserForm1.Show

UserForm1.ListBox1.Tag = ""

ElseIf sayac = 1 Then
UserForm1.ListBox1.Tag = "off"
Range(derlenen) = sonuc

Else

UserForm1.ListBox1.Tag = "off"
bakilan = ""
sayac = 0
For Each deger In Sheets("Sayfa2").Range("g5:g85")

If Not IsEmpty(deger.Value) And Left(deger.Value, Len(bakilan)) = bakilan Then

    sayac = sayac + 1
    sonuc = deger.Value
    
    If sayac = 1 Then
    UserForm1.ListBox1.Clear
    End If
    
    UserForm1.ListBox1.AddItem deger.Value

End If

Next
UserForm1.Tag = derlenen
UserForm1.Caption = "Uygun Kayit Bulunamadi, Lutfen Listeden Birini Seciniz"
Range(derlenen) = ""
UserForm1.Show


End If

Else
UserForm1.ListBox1.Tag = ""
End If

End Sub

kodları kırmızı ile belirttiğim şekilde değiştiriniz.
 
Kodlar görünmüyor galiba Sy BilalGungor,
Dosyayı konuya ekliyorum.
 
Son düzenleme:
Geri
Üst