Vba Satır gizle/göster sorunu

[bydilaver]

Merhabalar, Office 365 Tr kullanıyorum

Aşağıdaki kullandığım kod, normalde çalışıyordu ama ne olduysa sadece bir bölüm çalışmamaya başladı, defalarca kontrol etmeme rağmen bir türlü çalışmıyor;

Eğer E2 hücresi Ödeme ise ad yönetici ismi "odeme" olan satırı gizle /göster , burda sadece gizliyor ama göstermiyor aynı şekilde çalışan diger satırlar gizle / göster çalışıyor ancak bir tek bu kısım da sorun yaşıyorum,

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Dim odemeStart As Range, odemeEnd As Range
Dim onodemeStart As Range, onodemeEnd As Range
Dim trans1 As Range, trans2 As Range, trans3 As Range
Dim balay As Range
Dim odeme2 As Range
Dim f32 As Range

Application.EnableEvents = False ' Döngüsel olayları önlemek için olayları devre dışı bırakır

On Error GoTo ErrorHandler
' Ad Yöneticisindeki isimleri kullanarak ilgili satırları bul
Set odemeStart = Range(ThisWorkbook.Names("odeme").RefersToRange.Cells(1, 1).Address)
Set odemeEnd = Range(ThisWorkbook.Names("odeme").RefersToRange.Cells(ThisWorkbook.Names("odeme").RefersToRange.Rows.Count, 1).Address)
Set onodemeStart = Range(ThisWorkbook.Names("onodeme").RefersToRange.Cells(1, 1).Address)
Set onodemeEnd = Range(ThisWorkbook.Names("onodeme").RefersToRange.Cells(ThisWorkbook.Names("onodeme").RefersToRange.Rows.Count, 1).Address)
Set trans1 = Range(ThisWorkbook.Names("trans1").RefersToRange.Address)
Set trans2 = Range(ThisWorkbook.Names("trans2").RefersToRange.Address)
Set trans3 = Range(ThisWorkbook.Names("trans3").RefersToRange.Address)
Set balay = Range(ThisWorkbook.Names("balay").RefersToRange.Address)
Set odeme2 = Range(ThisWorkbook.Names("odeme2").RefersToRange.Address)
Set f32 = odeme2 ' F32 hücresini odeme2 adından al
On Error GoTo 0

' Anahtar kelimeler bulunamazsa hata mesajı gösterir
If odemeStart Is Nothing Or odemeEnd Is Nothing Then
MsgBox "Ödeme satırları bulunamadı!"
GoTo EndSub
End If
If onodemeStart Is Nothing Or onodemeEnd Is Nothing Then
MsgBox "Onodeme satırları bulunamadı!"
GoTo EndSub
End If
If trans1 Is Nothing Then
MsgBox "Trans1 satırı bulunamadı!"
GoTo EndSub
End If
If trans2 Is Nothing Then
MsgBox "Trans2 satırı bulunamadı!"
GoTo EndSub
End If
If trans3 Is Nothing Then
MsgBox "Trans3 satırı bulunamadı!"
GoTo EndSub
End If
If balay Is Nothing Then
MsgBox "Balay satırı bulunamadı!"
GoTo EndSub
End If
If odeme2 Is Nothing Then
MsgBox "Odeme2 hücresi bulunamadı!"
GoTo EndSub
End If

' Değişiklik yapılan her hücre için
For Each c In Target
' Eğer hücre C sütununda ve 16. satırdan itibaren ise
If c.Column = 3 And c.Row >= 16 Then
' Eğer hücrede formül yoksa
If Not c.HasFormula Then
' Hücredeki metni baş harfleri büyük olacak şekilde düzenle
If Trim(c.Value) <> "" Then
c.Value = Application.WorksheetFunction.Proper(Trim(c.Value))
End If
End If
End If
Next c

' E2, E3, F15 ve odeme2 hücrelerinde değişiklik olup olmadığını kontrol eder
If Not Intersect(Target, Me.Range("E2, E3, F15")) Is Nothing Or Not Intersect(Target, f32) Is Nothing Then
' E2 hücresinde değişiklik varsa
If Not Intersect(Target, Me.Range("E2")) Is Nothing Then
If LCase(Me.Range("E2").Value) = "ödeme" Then
Rows(odemeStart.Row & ":" & odemeEnd.Row).EntireRow.Hidden = False
Else
Rows(odemeStart.Row & ":" & odemeEnd.Row).EntireRow.Hidden = True
End If
End If

' E3 hücresinde değişiklik varsa
If Not Intersect(Target, Me.Range("E3")) Is Nothing Then
Select Case Me.Range("E3").Value
Case "Transfer Yok"
trans1.EntireRow.Hidden = True
trans2.EntireRow.Hidden = True
trans3.EntireRow.Hidden = True
Case "Transfer Ücretsiz"
trans1.EntireRow.Hidden = True
trans2.EntireRow.Hidden = False
trans3.EntireRow.Hidden = False
Case Else
trans1.EntireRow.Hidden = False
trans2.EntireRow.Hidden = False
trans3.EntireRow.Hidden = False
End Select
End If

' F15 hücresinde değişiklik varsa
If Not Intersect(Target, Me.Range("F15")) Is Nothing Then
If LCase(Me.Range("F15").Value) = "yok" Then
balay.EntireRow.Hidden = True
Else
balay.EntireRow.Hidden = False
End If
End If

' F32 (odeme2) hücresinde değişiklik varsa
If Not Intersect(Target, f32) Is Nothing Then
If LCase(f32.Value) = "var" Then
Rows(onodemeStart.Row & ":" & onodemeEnd.Row).EntireRow.Hidden = False
ElseIf LCase(f32.Value) = "yok" Then
Rows(onodemeStart.Row & ":" & onodemeEnd.Row).EntireRow.Hidden = True
End If
End If
End If

EndSub:
Application.EnableEvents = True ' Olayları yeniden etkinleştirir
Exit Sub

ErrorHandler:
MsgBox "Hata: " & Err.Description
Resume EndSub
End Sub

 

[Muzaffer Ali]

Merhaba.
1- Sayfaya koruma uyguladıysanız hata verir. Kodların başında koruma kaldırılmalı sonunda yeniden koruma yapılabilir.

2- Çalışmıyorun çok anlamı var, kodlar hiç çalışmıyor, kodlar çalışıyor ama işlevini yerine getirmiyor, kodlar çalışınca hata veriyor.
Çalışmıyordan neyi kast ediyorsunuz? Eğer hata veriyorsa hangi satırda ve hata mesajını da paylaşın.
Son olarak dosyanızı da paylaşırsanız çok daha doğru ve hızlı yanıt alabilirsiniz.

Dosyanızı dosya.tc gibi bir sitede paylaşabilirsiniz.