Hücredeki çoktan seçmeli değere göre sütun gizleme ve gösterme

[adigeturklim]

Merhaba, yapmak istediğim ile ilgili bir dosya ekledim. Yardımlarınızı rica ederim.

Buna göre;
1-2019 Yılı Toplamı = (seçim kısmında bu ifade seçildiğinde sadece 2019 Yıl toplamı stünu gelmelidir.)
2-2019 Yılı Aylar = (seçim kısmında bu ifade seçildiğinde sadece 2019 Yılı ay toplamları ve2019 yıl toplam stünları gelmelidir.)
3-2019 Yılı Günler = (seçim kısmında bu ifade seçildiğinde sadece 2019 yılına ait gün-ay-yıl sütunları gelmelidir..)
Tüm Yıl Toplamları = (seçim kısmında bu ifade seçildiğinde sadece 2019-2020-21-22-23 yıl toplam stünları gelmelidir.)
Tüm Tablo = (seçim kısmında bu ifade seçildiğinde sadece tablonun tüm stünları görünür olmalıdır.

1,2,3 nolu işlemler tabloda yer alan 2020-2021-2022-2023 içinde aynı şekilde işlevsel olmaldır.

Sayg.

 

[Ömer BARAN]

Merhaba.

Alt taraftan Sheet1 isimli sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçtiğinizde açılacak VBA ekranında
sağdaki boş alana aşağıdaki kod blokunu yapıştırdıktan sonra D2 hücresindeki seçimde değişiklikler yaparak sonucu gözlemleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D2]) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
yil = Left(Target, 4)
Columns("F:AZV").AutoFit
Columns("F:AZV").EntireColumn.Hidden = True
If Right(Target, 7) = "Toplamı" Then
    sut = WorksheetFunction.Match(yil & " TOPLAM", [7:7], 0)
    Columns(sut).EntireColumn.Hidden = False
ElseIf Right(Target, 5) = "Aylar" Then
    For sut = WorksheetFunction.Match("*" & yil, [7:7], 0) To Columns.Count
        If Not IsNumeric(Left(Cells(7, sut), 1)) Then
            If Right(Cells(7, sut), 4) = yil Then
                ay = ay + 1: Columns(sut).EntireColumn.Hidden = False
                If ay = 12 Then Exit For
            End If
        End If
    Next
ElseIf Right(Target, 6) = "Günler" Then
    If yil = "2019" Then
        ilk = 6
    Else: ilk = WorksheetFunction.Match(yil - 1 & " TOPLAM", [7:7], 0) + 1
    End If
    If yil = "2023" Then
        son = 1373
    Else: son = WorksheetFunction.Match(yil & " TOPLAM", [7:7], 0) - 2
    End If
    For sut = ilk To son
        If IsNumeric(Left(Cells(7, sut), 1)) Then Columns(sut).EntireColumn.Hidden = False
    Next
ElseIf Right(Target, 10) = "Toplamları" Then
    For sut = 6 To 1374
        If Right(Cells(7, sut), 6) = "TOPLAM" Then Columns(sut).EntireColumn.Hidden = False
    Next
ElseIf Left(Target, 3) = "Tüm" Then
    Columns("F:AZV").EntireColumn.Hidden = False
End If
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End Sub

 

[adigeturklim]

Merhaba.

Alt taraftan Sheet1 isimli sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçtiğinizde açılacak VBA ekranında
sağdaki boş alana aşağıdaki kod blokunu yapıştırdıktan sonra D2 hücresindeki seçimde değişiklikler yaparak sonucu gözlemleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D2]) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
yil = Left(Target, 4)
Columns("F:AZV").AutoFit
Columns("F:AZV").EntireColumn.Hidden = True
If Right(Target, 7) = "Toplamı" Then
    sut = WorksheetFunction.Match(yil & " TOPLAM", [7:7], 0)
    Columns(sut).EntireColumn.Hidden = False
ElseIf Right(Target, 5) = "Aylar" Then
    For sut = WorksheetFunction.Match("*" & yil, [7:7], 0) To Columns.Count
        If Not IsNumeric(Left(Cells(7, sut), 1)) Then
            If Right(Cells(7, sut), 4) = yil Then
                ay = ay + 1: Columns(sut).EntireColumn.Hidden = False
                If ay = 12 Then Exit For
            End If
        End If
    Next
ElseIf Right(Target, 6) = "Günler" Then
    If yil = "2019" Then
        ilk = 6
    Else: ilk = WorksheetFunction.Match(yil - 1 & " TOPLAM", [7:7], 0) + 1
    End If
    If yil = "2023" Then
        son = 1373
    Else: son = WorksheetFunction.Match(yil & " TOPLAM", [7:7], 0) - 2
    End If
    For sut = ilk To son
        If IsNumeric(Left(Cells(7, sut), 1)) Then Columns(sut).EntireColumn.Hidden = False
    Next
ElseIf Right(Target, 10) = "Toplamları" Then
    For sut = 6 To 1374
        If Right(Cells(7, sut), 6) = "TOPLAM" Then Columns(sut).EntireColumn.Hidden = False
    Next
ElseIf Left(Target, 3) = "Tüm" Then
    Columns("F:AZV").EntireColumn.Hidden = False
End If
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End Sub

 

[adigeturklim]

Merhaba Ömer Bey, rahatsızlığımdan dolayı dönüş yapamadım kusura bakmayın. Teşekkür ederim yardımlarınız için..