DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Sub ŞARTLI_SATIR_SÜTUN_GİZLE()
Application.ScreenUpdating = False
With Cells
.EntireRow.Hidden = False
.EntireColumn.Hidden = False
End With
If Range("A2") = "" Then
Range("A3:A65536").EntireRow.Hidden = True
Else
Range("A" & Range("A65536").End(3).Row + 1 & ":A65536").EntireRow.Hidden = True
End If
Columns("AV:IV").EntireColumn.Hidden = True
Application.ScreenUpdating = True
End Sub
Selamlar,
Kodun hangi durumda çalışacağını belirtmemişsiniz. Aşağıdaki kodu deneyiniz.
Not: Profil bölümünüzde 2007 versiyon kullandığınızı belirtmişsiniz. Kodlar 2007 versiyon için düzenlenmiştir. Önceki versiyonlarda hata verecektir.
Kod:Option Explicit Sub ŞARTLI_SATIR_SÜTUN_GİZLE() With Cells .EntireRow.Hidden = False .EntireColumn.Hidden = False End With If Range("A2") = "" Then Range("A2:A1048576").EntireRow.Hidden = True Else Range("A2:A" & Range("A1048576").End(3).Row).EntireRow.Hidden = True End If Columns("AV:XFD").EntireColumn.Hidden = True End Sub
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Columns("AV:IV").Hidden = True
Cells.EntireRow.Hidden = False
If Range("A2") = "" Then
Range("A3:A65536").EntireRow.Hidden = True
Else
Range("A" & Range("A65536").End(3).Row + 2 & ":A65536").EntireRow.Hidden = True
End If
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A2:A65536")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Columns("AV:IV").Hidden = True
Cells.EntireRow.Hidden = False
If Range("A2") = "" Then
Range("A3:A65536").EntireRow.Hidden = True
Else
Range("A" & Range("A65536").End(3).Row + 2 & ":A65536").EntireRow.Hidden = True
End If
Application.ScreenUpdating = True
End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim bas
Dim son
Dim baslangic
Dim bitis
Dim bas1
bas1 = Cells(Rows.Count, "a").End(3).Row
If Intersect(Target, Range("A" & bas1 & ":A" & bas1)) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
With Cells
.EntireRow.Hidden = False
.EntireColumn.Hidden = False
End With
bas = Cells(Rows.Count, "a").End(3).Row + 2
son = Rows.Count
Rows(bas & ":" & Rows.Count).EntireRow.Hidden = True
baslangic = Left(Columns(48).Address(0, 0), InStr(Columns(48).Address(0, 0), ":") - 1) 'AV sütunundan başlıyor
bitis = Left(Columns(Columns.Count).Address(0, 0), InStr(Columns(Columns.Count).Address(0, 0), ":") - 1)
Columns(baslangic & ":" & bitis).EntireColumn.Hidden = True
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim BUL As Range
If Intersect(Target, Range("B3")) Is Nothing Then Exit Sub
Cells.EntireRow.Hidden = False
If Target <> "" Then
Set BUL = Range("A:A").Find(Target, , , xlWhole)
If Not BUL Is Nothing Then
If BUL.Row > 7 Then
Range("A7:A" & BUL.Row - 1).EntireRow.Hidden = True
Else
Range("A7:A" & BUL.Row).EntireRow.Hidden = True
End If
End If
Set BUL = Nothing
End If
End Sub