şartlı satır silmek

[falanca09]

Merhabalar biraz uzun olacak sanırım ama derdimi anlatmaya çalışayım.

"VERİ" sayfasında


(a1hücresi)x sistemi / (b1hücresi) var
(a2hücresi)y sistemi / (b2hücresi) yok
(a3hücresi)z sistemi / (b3hücresi) var

B Sütununda Sırasıyla (var/yok veri doğrulama ile seçiliyor)

sonuç olarak x,y,z... sisteminin olup olmayacağı konusunda seçimini burada yapıyorum.

ve a1,a2,a3 diye devam ediyor.


"ÇIKTI" sayfasında ise

(a1hücresi)1 / (b1hücresi) x sistemi
(a2hücresi)1 / (b2hücresi) x1 sistemi
(a3hücresi)1 / (b3hücresi) x2 sistemi
(a4hücresi)1 / (b4hücresi) x3 sistemi
(a5hücresi)1 / (b5hücresi) x4 sistemi
(a6hücresi)1 / (b6hücresi) x5 sistemi
(a7hücresi)0 / (b7hücresi) y sistemi
(a8hücresi)0 / (b8hücresi) y1 sistemi
(a9hücresi)0 / (b9hücresi) y2 sistemi
(a10hücresi)1 / (b10hücresi) z sistemi
(a11hücresi)1 / (b11hücresi) z1 sistemi
(a12hücresi)1 / (b12hücresi) z2 sistemi
(a13hücresi)1 / (b13hücresi) z3 sistemi

burada x sisteminin olup olmaması sonucunu veri sayfasından var ya da yok seçerek a hücresini 1 ya da 0 yazdırıyorum. x1,x2,....xn için ise bir üstteki veri neyse onu yaz diyorum. yani x sistemi 1 ise x1=1 x2=1 diye devam ediyor.

Benim isteğim şu;
- veri sayfasında "yok" olarak seçim yaptığım zaman
çıktı sayfasında A sütunda "0" değerini içeren hücrelerin satırları otomatik olarak gizlensin.
- veri sayfasında "yok" seçimini "var" olarak değiştirdiğim zaman gizlenen hücreler tekrar gösterilsin istiyorum.
- makro, veri sayfasında ki herhangi var/yok seçimi yapıldığında çalışsın istiyorum.

yardımcı olabilir misiniz?

 

[Ömer BARAN]

Merhaba.

Sorunuzu örnek belge üzerinden sorarsanız daha hızlı ve net sonuca ulaşabilir, alternatif cevaplar alabilirsiniz diye düşünüyorum.

Örnek belge özellikleri ve örnek belge yükleme yöntemi konusundaki açıklamalar cevabıın altındaki İMZA bölümünde var.
.

 

[falanca09]

Biraz araştırma yaptım ve böyle bir makro buldum.
Ancak çok yavaş çalışıyor. Bunu nasıl hızlandırabiliriz. (10000'e kadar veri girişi olabiliyor)

Private Sub Worksheet_Activate()
On Error Resume Next
Dim bul As Range
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
For Each bul In Range("a6:a5000")
If bul.Value = "0" Then
Rows(bul.Row).Hidden = True
Else
Rows(bul.Row).Hidden = False
End If
Next bul
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

 

[PLİNT]

Merhaba
Son mesajınızdaki kod; aşağıdaki şekilde daha hızlı olacaktır.

[SIZE="2"]Private Sub Worksheet_Activate()
On Error Resume Next
Dim bul As Range
Dim s1 As Worksheet
Set s1 = Sheets("Sayfa1")
s1.Cells.EntireRow.Hidden = False
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
x = s1.Cells(Rows.Count, 1).End(3).Row
With s1.Range("a1:a" & x)
    Set bul = .Find(0, LookIn:=xlValues, lookat:=xlWhole)
    If Not bul Is Nothing Then
        f = bul.Address
        Do
s1.Rows(bul.Row).Hidden = True
            Set bul = .FindNext(bul)
If bul Is Nothing Then Exit Do
        Loop While Not bul Is Nothing And bul.Address <> f
    End If
End With
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
 [/SIZE]