vba ve döngü ile sütun gizleme

[kalibre101]

merhabalar yardıma ihtiyacım var çalıştıgım excel kitabının
sayfa 111 A5 hücresinde "ÇIKAR" yazdımı sayfa 2 ve sayfa 32 arasındaki tüm sayfalarda LE stununu gizlesin
sayfa 111 A5 Hücresinin 1 sağında "ÇIKAR" yazdımı sayfa 2 ve sayfa 32 arasındaki tüm sayfalarda LE stununun 1 sagındaki stunu gizlesin
bu şekilde 324 stun var
ben bişey denedim ama şaçmalamış olabilirim

Sub ÇIKAR()
Dim hafıza As Range, a As Integer, b As Byte, hafıza2 As Range
For a = 1 To 324
hafıfa = Sheets(111).Range("A5")
hafıza = hafıza.Offset(0, a)
If hafıza = "ÇIKAR" Then
For b = 2 To 32
hafıza2 = Sheets(b).[2:317]
hafıza2 = Sheets(b).[2:317].Offset(0, a)
hafıza2.EntireColumn.Hidden = True
Next b
End If
Next a
End Sub

hafıza = hafıza.Offset(0, a) kısmında hata verdi
yardımcı olursanız çok sevinirim

 

[Muzaffer Ali]

Merhaba.

Sub Test()
    Dim Bak As Long
    Dim GizleGoster As Boolean
    If Range("A5") = "ÇIKAR" Then
        GizleGoster = True
    ElseIf Range("B5") = "ÇIKAR" Then
        GizleGoster = False
    End If
    For Bak = 2 To 32
        Worksheets("Sayfa" & Bak).Columns("LE").Hidden = GizleGoster
        Worksheets("Sayfa" & Bak).Columns("LF").Hidden = Not GizleGoster
    Next
End Sub

 

[kalibre101]

Merhaba.

Sub Test()
    Dim Bak As Long
    Dim GizleGoster As Boolean
    If Range("A5") = "ÇIKAR" Then
        GizleGoster = True
    ElseIf Range("B5") = "ÇIKAR" Then
        GizleGoster = False
    End If
    For Bak = 2 To 32
        Worksheets("Sayfa" & Bak).Columns("LE").Hidden = GizleGoster
        Worksheets("Sayfa" & Bak).Columns("LF").Hidden = Not GizleGoster
    Next
End Sub

Worksheets("Sayfa" & Bak).Columns("LE").Hidden = GizleGoster
Kısmında hata verdi
bilmiyorum ama bu kodla sadece LE ve LF mi gizleniyor acaba çünkü bana bunun gibi yanyana 324 sütun var çıkar yazdımı gizleyecek değilse göstercek belki ben yanlış anlatmış olabilirim kusura bakmayın.
sırayla A5 -B5 -C5....... diye bakıp sonuçta çıkar yazıyorsa
2ve 32 sayfalar arasında LE ,LF,LG.....gizleyecek degilse gösterecek

 

[Muzaffer Ali]

Evet soruyu tamamen eksik yazmışsınız.

A5 -B5 -C5....... ve devamında en son hangi hücreye kadar kontrol edileceğini de söyleyin.
Sayfalarınızın isimlerini sadece tahmin ettim, sayfa isimlerini de bilmeliyiz. Hata sayfa isminden kaynaklanıyor.
Örnek dosya da ekleyin.

 

[kalibre101]

Evet soruyu tamamen eksik yazmışsınız.

A5 -B5 -C5....... ve devamında en son hangi hücreye kadar kontrol edileceğini de söyleyin.
Sayfalarınızın isimlerini sadece tahmin ettim, sayfa isimlerini de bilmeliyiz. Hata sayfa isminden kaynaklanıyor.
Örnek dosya da ekleyin.

Günlük işletme ÇALIŞMA v132.xlsb

drive.google.com

Sayfa index 111 sayfa ismi kopya ekranı
bu sayfada A5 ile LL5 arasındaki hücrelerde ÇIKAR yazıyorsa
sayfa index 2 ve 32 arası sayfa ismi ise 1 - 31 arası
bu sayfalardaki LE ile XP arasındaki hangi sütuna denk geliyorsa o sütunu gizleyecek değilse gösterecek
sanırım daha açıklayıcı oldu

dosyayı vba şifresi =mert2008
sayfa koruma şifre=2227
çalışma kitabı şifre=123
yardımlarınız için çok teşekkür ederim

 

[Muzaffer Ali]

Kopya Ekranı adlı sayfanın kod kısmına aşağıdaki kodu kopyalayın.
Kopya Ekranı adlı sayfanın "A5:LL5" arasında bir hücreye "ÇIKAR" yazınca ve silince aşağıdaki kod otomatik çalışacak ve gerekli kolonu gizleyip gösterecektir.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bak As Long
    If Not Intersect(Target, Range("A5:LL5")) Is Nothing Then
        For Bak = 1 To 31
            With ThisWorkbook.Worksheets(Bak)
                If Target = "ÇIKAR" Then
                    .Columns(Target.Column + 316).Hidden = True
                ElseIf Target = "" Then
                    .Columns(Target.Column + 316).Hidden = False
                End If
            End With
        Next
    End If
End Sub

 

[kalibre101]

Kopya Ekranı adlı sayfanın kod kısmına aşağıdaki kodu kopyalayın.
Kopya Ekranı adlı sayfanın "A5:LL5" arasında bir hücreye "ÇIKAR" yazınca ve silince aşağıdaki kod otomatik çalışacak ve gerekli kolonu gizleyip gösterecektir.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bak As Long
    If Not Intersect(Target, Range("A5:LL5")) Is Nothing Then
        For Bak = 1 To 31
            With ThisWorkbook.Worksheets(Bak)
                If Target = "ÇIKAR" Then
                    .Columns(Target.Column + 316).Hidden = True
                ElseIf Target = "" Then
                    .Columns(Target.Column + 316).Hidden = False
                End If
            End With
        Next
    End If
End Sub

Çok Teşekkür ederim çok güzel olmuş

 

[kalibre101]

Çok Teşekkür ederim çok güzel olmuş

sizden bir ricam daha olsa çok özür dilerim
bu kod çalıştıktan sonra
kopya ekranı sayfasındaki A4 VE LL4 arasındaki hücrelere hidden true durumunda çıkarıldı ve hidden false durumunda eklendi yazdırabilirmiyiz

 

[Muzaffer Ali]

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bak As Long
    If Not Intersect(Target, Range("A5:LL5")) Is Nothing Then
        For Bak = 1 To 31
            With ThisWorkbook.Worksheets(Bak)
                If Target = "ÇIKAR" Then
                    .Columns(Target.Column + 316).Hidden = True
                    Target.Offset(-1, 0) = "Çıkarıldı"
                ElseIf Target = "" Then
                    .Columns(Target.Column + 316).Hidden = False
                    Target.Offset(-1, 0) = "Eklendi"
                End If
            End With
        Next
    End If
End Sub

 

[kalibre101]

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bak As Long
    If Not Intersect(Target, Range("A5:LL5")) Is Nothing Then
        For Bak = 1 To 31
            With ThisWorkbook.Worksheets(Bak)
                If Target = "ÇIKAR" Then
                    .Columns(Target.Column + 316).Hidden = True
                    Target.Offset(-1, 0) = "Çıkarıldı"
                ElseIf Target = "" Then
                    .Columns(Target.Column + 316).Hidden = False
                    Target.Offset(-1, 0) = "Eklendi"
                End If
            End With
        Next
    End If
End Sub

çok teşekkürler hayırlı işler dilerim