Filtrelemeye bağlı boş olan sütunların otomatik gizlenmesi

[adanalılegolas]

Herkese merhabalar,

Bu konuyu sadece yazarak anlatacağım için üzgünüm. Elimden geldiği kadar en ayrıntısıyla anlatmaya çalışacağım. Excel dosyasının B3 hücresinde "FİRMA", C3 hücresinde PROJE, D3 Tarih ve E3 hücresinde "RENKSİZ SATILAN BOYA MİKTARI" yazmaktadır.
Ardından gelen F3 sütunundan itibaren her 2 hücre birleştirilmiştir. Örn: F3 ve G3, GN3 ve GO3 birleştirilmiş hücredir şu an için en son birleştirilmiş hücreler KJ3 ve KK3 hücreleridir. Bu hücrelerde verilen hizmet yazmaktadır. Birleştirilmiş hücrelerin üstünde "litre" miktarı yazmaktadır.

B4 sütununda firma ve bu firmanın proje ve tarih verileri manuel olarak girilmektedir. Birleştirilmiş hücrelerin "örn: F3 ve G3" altındaki hücreler yine tek hücreden oluşmakta ve birinde adet miktarı, diğerinde EĞER adet miktarı boş değilse ADET* (BİRLEŞİK (1)HÜCRE (2))"birleşik hücre içinde yazan miktar ile çarpım sonucunu vermektedir.

RENKSİZ SATILAN BOYA MİKTARI altında da (=TOPLA.ÇARPIM((MOD(SÜTUN($F5:$AAB5)+3;2)=0)*ESAYIYSA($F5:$AAB5);($F5:$AAB5)) formülüyle, satır boyunca BİRLEŞİK (A) altında yazan litre miktarlarının toplamı yazmaktadır.
örn: B5 hücresinde "DDD" yazmakta. F5 hücresine 4 yazıldığı için, Birleştirilmiş hücre olan F2 ve G2' de (bkz: BİRLEŞİK (1) HÜCRE (2)) 12,5 yazdığı için G5 hücresindeki =EĞER($AD$2*F5=0;"";$AD$2*F5) formülden dolayı 50 yazmaktadır.


Gelelim ihtiyacım olan makroya, B3 hücresinde bulunan herhangi bir firma seçtiğimde, boş olan sütunların otomatik olarak gizlenmesi. Örn: FFF firması seçildiğinde F, G, H ve I sütunlarının gizlenmesi.

İlgi ve alakanız için teşekkür ederim.

b2 boş	c2 boş	d2 boş	e2 boş	f2 BİRLEŞİK (1) 12,5	g2 HÜCRE (2) 12,5	h2 BİRLEŞİK (3) 12,5	ı2 HÜCRE (4) 12,5	j2 BİRLEŞİK (5) 20	k2 HÜCRE (6) 20
FİRMA	PROJE	TARİH	RENKSİZ SATILAN BOYA MİKTARI	BİRLEŞİK (A)	HÜCRE (B)	BİRLEŞİK (c)	HÜCRE (d)	BİRLEŞİK (e)	HÜCRE (f)
AAA	BBB	CCC	TOPLAM LİTRE	ADET	LİTRE	ADET	LİTRE	ADET	LİTRE
DDD	EEE	CCC	200	4	50	4	50	5	100
FFF	GGG	XXX	250					5	250
FFF	HHH	YYY	100					2	50
FFF	GGG	III	50					1	50

 

[Korhan Ayhan]

Merhaba,

Küçük bir örnek dosya paylaşırsanız konu daha net anlaşılır..

 

[Biolightant]

Merhaba,
Sorunuzdan benim anladığıma göre...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim cell As Range
    Dim col As Integer
    Dim row As Integer

    Application.ScreenUpdating = False

    ' F sütunundan KK sütununa kadar olan tüm sütunları görünür yap
    ActiveSheet.Range("F:KK").EntireColumn.Hidden = False

    ' Seçili hücre B sütununda B3'ten aşağıda mı kontrol et
    If Not Intersect(Target, ActiveSheet.Range("B3:B" & ActiveSheet.Rows.Count)) Is Nothing Then
        row = Target.row

        ' F sütunundan KK sütununa kadar kontrol et
        For col = 6 To Columns("KK").Column
            Set cell = ActiveSheet.Cells(row, col)

            ' Hücre boş, sıfır veya boş string ise sütunu gizle
            If IsEmpty(cell.Value) Or cell.Value = 0 Or cell.Value = "" Then
                ActiveSheet.Columns(col).EntireColumn.Hidden = True
            End If
        Next col
    End If

    Application.ScreenUpdating = True
End Sub