İki aşamalı tablolarda gizle göster uygulaması

[belarafon]

Herkese selamlar,

Oluşturduğum tabloda şöyle bir sorun ile karşı karşıyayım.

Tablonun her bir satırının kendine ait, satırın aşağısına doğru sıralanmış 5 er satırdan oluşan birer alt bilgi tablosu var.

Asıl verilerin sıralandığı tablo yaklaşık 1.000 satırdan oluşuyor. 5.000 kadar da alt bilgi satırı olacak. Toplamda 6.000 satırlık bir çalışma sayfası oluşacak.

Bilgi girişi yapılmadığı zamanlarda bu alt bilgi satırlarının düğme kullanmaksızın, belki hücre başvurusu ile kapanmasını ve açılmasını sağlamak istiyorum.

Ne yapmaya çalıştığım hakkında daha detaylı bilgi ekteki dosyada mevcut. İnceler ve çözüm önerileri sunarsanız çok sevinirim.

Saygılar,

 

[excel03]

merhaba;
ekli dosyayı inceleyiniz.

 

[belarafon]

Dostum saygılar sevgiler,

Gerçekten harika ve temiz bir iş çıkartmışsın, bravo. Ama bende dert bitmez. Tabloda şöyle bir sorun fark ettim;

Mor satırlardan ikisini yada daha fazlasını seçer ve sil dersem aradaki kahverengi saturları da, gizlenmiş de olsalar, siliyor !!

Tahmin edersin ki bu sayfayı kullanılamaz duruma sokacak çok önemli bir güvenlik açığı demek. Bunun için de bir çözüm önerin varsa çok sevinirim.

Tekrar saygılar,

 

[belarafon]

Tamam dostum çözdüm sorunu.

Başlıkları koruma altına alınca o sorun ortadan kalktı.

Görüşmek üzere,

 

[belarafon]

Tamam dostum çözdüm o sorunu,

Başlık satırlarını koruma altına altınca aradaki satırlar da kurtuluyor.

Görüşmek üzere,

 

[belarafon]

Sayfanın üstüne satır eklediğimde makro bozuluyor.

Kodu inceledim ama nasıl uyarlarım çözemedim.

Sub SatırGizle()
kalan = ((ActiveCell.Row) - 6) Mod 8
If kalan = 0 And ActiveCell.Value = "Gizle" Then
sat = ActiveCell.Row
satG1 = sat + 1
satG2 = sat + 7
Rows(satG1 & ":" & satG2).EntireRow.Hidden = True
End If

If kalan = 0 And ActiveCell.Value = "Göster" Then
sat = ActiveCell.Row
satG1 = sat + 1
satG2 = sat + 7
Rows(satG1 & ":" & satG2).EntireRow.Hidden = False
End If
End Sub

ve


Private Sub Worksheet_Change(ByVal Target As Range)
SatırGizle
End Sub

kodlarını eklemişsin.

Sayfaya satır yada sütun eklersem kodları ne şekilde uyarlamam gerekir? Yardımcı olabilir misin lütfen ?

 

[belarafon]

Dostum,

Beni unutma, zaman içinde satırlar ve sutünlar eklemem gerekecek tabloya. Satır ve sutün eklersem nasıl uyarlamam gerekir senin kodunu, lütfen yardım eder misin ?

 

[belarafon]

Dosyanın son hali ve ben hala kodu çalıştıramadım.

 

[excel03]

dosyanızı açmakta sıkıntılar yaşıyorum.
.xls şeklinde upload edermisiniz?

 

[belarafon]

Sn. 03,

Dosyayı tekrar yolluyorum. .xls uzantısıyla.

Sorun .rar formatını açmak ise,

http://rapidshare.com/files/448677423/Karma_Test_3.6.xls

yukarıdaki bu linkten dosyayı sıkıştırılmamış haliyle de alabilirsiniz.

 

[excel03]

merhaba;

'modül kısmına
Sub SatırGizle()
sut = ActiveCell.Column
If ActiveCell.Value = "Gizle" Then
sat = ActiveCell.Row
SonS = Range("b" & sat).End(xlDown).Row
satG1 = sat + 1
20:
j = j + 1
If ActiveCell.Offset(j, -(sut - 2)).Interior.ColorIndex = 39 Then
x = ActiveCell.Offset(j, -(sut - 2)).Address
satG2 = ActiveCell.Offset(j, 0).Row - 1
Else
x = ActiveCell.Offset(j, -(sut - 2)).Address
GoTo 20
End If
j = 0
Rows(satG1 & ":" & satG2).EntireRow.Hidden = True
End If

If ActiveCell.Value = "Göster" Then
sat = ActiveCell.Row
satG1 = sat + 1
10:
i = i + 1
If ActiveCell.Offset(i, -(sut - 2)).Interior.ColorIndex = 39 Then
x = ActiveCell.Offset(i, -(sut - 2)).Address
satG2 = ActiveCell.Offset(i, 0).Row - 1
Else
x = ActiveCell.Offset(i, -(sut - 2)).Address
GoTo 10
End If
i = 0
Rows(satG1 & ":" & satG2).EntireRow.Hidden = False
End If
End Sub

'karma işlemi sayfa koduna
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 Then
SatırGizle
End If
End Sub

 

[belarafon]

Sn excel03,

Çok teşekkürler, kodları kaydettim ama çalışmadı. Kodların kayıtlı olduğu dosya tekrar ekte. Göz atarsanız çok sevinirim. Her şey için teşekkürler,

http://hotfile.com/dl/107683081/f1ee766/Karma_Test_3.6.2.xls.html

Saygılarımla,

 

[excel03]

Merhaba;
Kodlarda bir sıkıntı yok.Belirttiğiniz şartları yerine getiriyor.