eger a1 boşsa 40 satırı gizle

[kokotuna]

merhaba arkadaşlar... Şöyle bir sorum var??
eğer a1 hücresi boşsa a1 hücresinin altındaki 40 satırı gizlemesini istiyorum foluysa gizleme yapmıyacak.. Bu işlem için nasıl bi makro ve ya formül yazılmalı???

yardımcı olan arkadaşlara şimdiden teşekkürler....

son yazımda dosyayı ekledim ve dier sorumu ekledim arkadaşlar lütfen bi bakarmısınız???

 

[Necdet]

Merhaba,

Aşağıdaki kodları ilgili sayfanın kod bölümüne kopyalayıp deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, [A1]) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    If Target.Value = "" Then
        Rows("2:41").EntireRow.Hidden = True
    Else
        Rows("2:41").EntireRow.Hidden = False
    End If
    Application.ScreenUpdating = True
    
End Sub

 

[security]

Altarnatif

Sayfanın kod bölümüne

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a1")) Is Nothing Then Exit Sub
If Range("A1") = "" Then
Call gizle
Else
Call göster
End If
End Sub

Makroya

Sub gizle()
Range("A2:A41").Select
    Selection.EntireRow.Hidden = True
    Range("A1").Select
End Sub
Sub göster()
Range("A2:A41").Select
    Selection.EntireRow.Hidden = False
    Range("A1").Select
End Sub

 

[kokotuna]

Necdet beyin verdiği kodla işimi gördüm... Diğer arkadaşlara ve Necdet Bey'e vakit ayırdığı için teşekkür ederim....

 

[kokotuna]

arkadaşlar aynı şekilde a58 hücresi boşsada aynı işlemi yapmak istiyorum ama kodu ekledim değiştirerek olmadı nasıl eklemem gerekiyor??? eklediğim kod şu şekilde;


Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [A1]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
If Target.Value = "" Then
Rows("2:57").EntireRow.Hidden = True
Else
Rows("2:57").EntireRow.Hidden = False
End If
Application.ScreenUpdating = True
If Intersect(Target, [A58]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
If Target.Value = "" Then
Rows("59:113").EntireRow.Hidden = True
Else
Rows("59:113").EntireRow.Hidden = False
End If
Application.ScreenUpdating = True

End Sub

 

[security]

A58 den sonraki 40 satırı gizler...

Private Sub Worksheet_Change(ByVal Target As Range)
 
If Intersect(Target, [A58]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
If Target.Value = "" Then
Rows("59:98").EntireRow.Hidden = True
Else
Rows("59:98").EntireRow.Hidden = False
End If
Application.ScreenUpdating = True
 
End Sub

 

[security]

her 2 kodda çalışsın istiyorsanız...

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, [A1:A58]) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    If Range("a1").Value = "" Then
        Rows("2:41").EntireRow.Hidden = True
    Else
        Rows("2:41").EntireRow.Hidden = False
    End If
    If Range("a58").Value = "" Then
        Rows("59:98").EntireRow.Hidden = True
    Else
        Rows("59:98").EntireRow.Hidden = False
    End If
    Application.ScreenUpdating = True
    
End Sub

 

[kokotuna]

olmadı veya ben yapamadım eklemeleri istediğim şu;;
ağer a1 boşsa 57 ye kadar, a58 boşsa 114 e kadar, eğer a115 boşsa 171 e kadar gizlicek ve böyle devam edicek 10 kere tekrarlanmak üzere yani a1 a58 a115 ve katları şeklinde 10tane a boşsa olucak. bu üçünü yazar ve diğerlerinin nasıl ekleniceğini tarif ederseniz sizide fazla yormamış ve kendim yapmış olurum arkadaşlar...

 

[security]

Private Sub Worksheet_Change(ByVal Target As Range)
 
    If Intersect(Target, [A1:A58:A115]) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
 
    '1 KOD
    If Range("a1").Value = "" Then
        Rows("2:57").EntireRow.Hidden = True
    Else
        Rows("2:57").EntireRow.Hidden = False
    End If
 
    '2 KOD
    If Range("a58").Value = "" Then
        Rows("59:114").EntireRow.Hidden = True
    Else
        Rows("59:114").EntireRow.Hidden = False
    End If
 
    '3 KOD
      If Range("a115").Value = "" Then
        Rows("116:171").EntireRow.Hidden = True
    Else
        Rows("116:171").EntireRow.Hidden = False
    End If
 
    '4KOD ŞEKLİNDE DEVAM EDİN
 
    Application.ScreenUpdating = True
 
End Sub

3 TANESİNİ EKLEDİM DİĞERLERİNİ ÖRNEGE GÖRE EKLEYEBİLİRSİNİZ...

 

[Necdet]

Merhaba,

Kodları deneyiniz, yine ilgili sayfanın kod bölümüne kopyalayınız.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    Dim i As Long
    Dim j As Long
    If (Target.Row Mod 57) = 1 Then
        If Target.Value = "" Then
            Rows(Target.Row + 1 & ":" & Target.Row + 1 + 55).EntireRow.Hidden = True
        Else
            Rows(Target.Row + 1 & ":" & Target.Row + 1 + 55).EntireRow.Hidden = False
        End If
    End If
    
End Sub

 

[kokotuna]

sayın securty eklediğiniz kod işimi gördü ama son bi sorum olucak onuda gerçekleştirebilirsem işim çok kolaylaşıcak, şöyleki;
a stununa gelen değer bağ yapıştır ile otomatik gelmesini istiyorum geldiği formül şöyle; =EĞER(Bilgiler!$B$20>1;"SK2";"") bu A58 için ve diğerleride buna uygun şekilde devam ediyor... Ancak o sütunu bağ yapıştırla getirmeye çalıştığımda kodlar çalışmıyor... Yani eğer SK2 otomatik olarak geldiğinde o sütun dolu oluyor ancak gözükmesini istediğim yerleri göstermiyor ve aynı şekilde boş olduğunda gizlemiyor... Acaba bununda bi çözümü varmıdır????

 

[security]

elle veri girmeniz gerekecek malesef... formullerle olmuyor...

 

[Necdet]

Bizim ikinci kodlar gümbürtüye gitti galiba

İkinci sorunuz için de dosyayı görmekte yarar var da, neyse...

 

[kokotuna]

necdet bey yok ya sizin kısalttığınız kod çok işime yaradı onu kullanıyorum ama dediğim gibi bağ yapıştırda çalışsaydı çok iyi olurdu ona bi çözüm bulabilsek keşke ???

 

[Necdet]

necdet bey yok ya sizin kısalttığınız kod çok işime yaradı onu kullanıyorum ama dediğim gibi bağ yapıştırda çalışsaydı çok iyi olurdu ona bi çözüm bulabilsek keşke ???

bulabilsek keşke diyorsunuz da bir örnek dosya eklemiyorsunuz, belkide bir çözümü vardır ne bileyim

 

[kokotuna]

dosya ekte

dosyayı ekledim arkadaşlar inşallah bi çözüm bulunur....

 

[kokotuna]

yapabilen yokmu arkadaşlar???