serkans
Altın Üye
- Katılım
- 18 Ekim 2004
- Mesajlar
- 171
- Excel Vers. ve Dili
- Office LTSC Pro Plus 21 64 Bit
Merhaba
Ekteki dosyada "F" sütununa plaka kodunu yazınca, "G" sütununa il ismini yazıyor. Ancak "F" sütunundan plaka kodunu silince "G" sütunundan il ismini silmiyor. Ayrıca bunu "I" sütununa plaka yazınca "J" sütununa da il ismini yazacak şekilde düzenleyemedim.
Sizden ricam, plakayı silince il ismini silsin ve aynı işlemleri "I" sütunu için de yapsın.
Ayrıca otomatik tamamlama yapan aşağıdaki kodu da aynı kodun devamına ekleyemedim.
Şimdiden teşekkürler...
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, [H:H,K:K]) 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("Veriler").Range("D1
508")
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("Veriler").Range("D1
508")
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
Ekteki dosyada "F" sütununa plaka kodunu yazınca, "G" sütununa il ismini yazıyor. Ancak "F" sütunundan plaka kodunu silince "G" sütunundan il ismini silmiyor. Ayrıca bunu "I" sütununa plaka yazınca "J" sütununa da il ismini yazacak şekilde düzenleyemedim.
Sizden ricam, plakayı silince il ismini silsin ve aynı işlemleri "I" sütunu için de yapsın.
Ayrıca otomatik tamamlama yapan aşağıdaki kodu da aynı kodun devamına ekleyemedim.
Şimdiden teşekkürler...
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, [H:H,K:K]) 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("Veriler").Range("D1
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("Veriler").Range("D1
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
