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

Emir Hüseyin Çoban

Destek Ekibi
Destek Ekibi
Katılım
11 Ağustos 2008
Mesajlar
5,892
Excel Vers. ve Dili
Office 2013 Tr - Win10 x64
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.
 

Emir Hüseyin Çoban

Destek Ekibi
Destek Ekibi
Katılım
11 Ağustos 2008
Mesajlar
5,892
Excel Vers. ve Dili
Office 2013 Tr - Win10 x64
Kodlar görünmüyor galiba Sy BilalGungor,
Dosyayı konuya ekliyorum.
 
Son düzenleme:
Üst