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

adigeturklim

Altın Üye
Katılım
24 Nisan 2009
Mesajlar
213
Excel Vers. ve Dili
Windows 10 Pro / Excel 2016
Altın Üyelik Bitiş Tarihi
10-10-2028
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.
 

Ekli dosyalar

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
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.
Rich (BB code):
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
 
Son düzenleme:

adigeturklim

Altın Üye
Katılım
24 Nisan 2009
Mesajlar
213
Excel Vers. ve Dili
Windows 10 Pro / Excel 2016
Altın Üyelik Bitiş Tarihi
10-10-2028
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.
Rich (BB code):
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

Altın Üye
Katılım
24 Nisan 2009
Mesajlar
213
Excel Vers. ve Dili
Windows 10 Pro / Excel 2016
Altın Üyelik Bitiş Tarihi
10-10-2028
Merhaba Ömer Bey, rahatsızlığımdan dolayı dönüş yapamadım kusura bakmayın. Teşekkür ederim yardımlarınız için..
 
Üst