MESUT K
Altın Üye
- Katılım
- 26 Nisan 2019
- Mesajlar
- 221
- Excel Vers. ve Dili
-
İş'te:Excel 2016 eng
Ev'de:Excel 2013 tr
- Altın Üyelik Bitiş Tarihi
- 29-04-2025
Herkese Selamlar
Aşağıdaki kod düzeninde;
"Private Sub Worksheet_Change(ByVal Target As Range)" olmak üzere iki ayrı chance dizilimi var.
Bu kodları tek "Private Sub Worksheet_Change(ByVal Target As Range)" altında birleştiremediğim için aşağıdaki gibi hata alıyorum
Aşağıdaki kod düzenini tek "Private Sub Worksheet_Change(ByVal Target As Range)" altında birleştirilmesi için yardım istiyorum.
Saygılarımla
********************KODLAR**************************
'SATIR GİZLEME'
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [Q1]) Is Nothing Then Exit Sub
If [Q1] = "ada" Then
Rows("4:19").EntireRow.Hidden = False
Rows("20:41").EntireRow.Hidden = True
Rows("42:55").EntireRow.Hidden = True
Rows("56:71").EntireRow.Hidden = True
Rows("73:109").EntireRow.Hidden = False
ElseIf [Q1] = "parsel" Then
Rows("4:19").EntireRow.Hidden = True
Rows("20:41").EntireRow.Hidden = False
Rows("42:55").EntireRow.Hidden = True
Rows("56:71").EntireRow.Hidden = True
Rows("73:109").EntireRow.Hidden = False
End If
'OTOMATİK İSİM TARAMA'
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then
If Not UserForm1.ListBox1.Tag = "off" Then Exit Sub
If Intersect(Target, Range("W88")) 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("VERITABANI").Range("C295:C494")
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("VERITABANI").Range("C295:C494")
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
Aşağıdaki kod düzeninde;
"Private Sub Worksheet_Change(ByVal Target As Range)" olmak üzere iki ayrı chance dizilimi var.
Bu kodları tek "Private Sub Worksheet_Change(ByVal Target As Range)" altında birleştiremediğim için aşağıdaki gibi hata alıyorum
Aşağıdaki kod düzenini tek "Private Sub Worksheet_Change(ByVal Target As Range)" altında birleştirilmesi için yardım istiyorum.
Saygılarımla
********************KODLAR**************************
'SATIR GİZLEME'
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [Q1]) Is Nothing Then Exit Sub
If [Q1] = "ada" Then
Rows("4:19").EntireRow.Hidden = False
Rows("20:41").EntireRow.Hidden = True
Rows("42:55").EntireRow.Hidden = True
Rows("56:71").EntireRow.Hidden = True
Rows("73:109").EntireRow.Hidden = False
ElseIf [Q1] = "parsel" Then
Rows("4:19").EntireRow.Hidden = True
Rows("20:41").EntireRow.Hidden = False
Rows("42:55").EntireRow.Hidden = True
Rows("56:71").EntireRow.Hidden = True
Rows("73:109").EntireRow.Hidden = False
End If
'OTOMATİK İSİM TARAMA'
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then
If Not UserForm1.ListBox1.Tag = "off" Then Exit Sub
If Intersect(Target, Range("W88")) 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("VERITABANI").Range("C295:C494")
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("VERITABANI").Range("C295:C494")
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