Sütun gizleme makrosu yardım

[yusuf09]

J'den DE'ye kadar olan sütun aralığında bir önceki sütundaki hücreye değer girildiğinde sütun açma

J5 hücresine değer girdiğimde otomatik 3 sütun daha göstersin diğerlerini DE5 e kadar gizlesin
K5 hücresine değer girdiğimde otomatik 3 sütun daha göstersin diğerlerini DE5 e kadar gizlesin
L5 hücresine değer girdiğimde otomatik 3 sütun daha göstersin diğerlerini DE5 e kadar gizlesin
....


işlemini yaptıracak kod hakkında bilgisi olan arkadaş var mı?

 

[yusuf09]

bu siteden yardım alarak programlama yaptım yaklaşık 20 çalışma sayfaiı var ve son sayfada son işlemim kaldı acil yardımınıza ihtiyacım var

J5 hücresine değer girdiğimde sağ tarafına sütun ekleme
eklenen sütun K5 hücresine değer girdiğimde sağ tarafına sütun ekleme
eklenen sütun L5 hücresine değer girdiğimde sağ tarafına sütun ekleme
......

böyle bir kod da işimi görür ancak önceki sütunun formülleri şekillendirmesi veri doğrulamaları vs de geçmesi lazım o yüzden sütun gizleme olursa daha rahat olacak

sütun gizle olarak kod yazmak kolay ise hücreye değer girildiğinde bir sonraki sütun göstersin gibi bir kod da iş görür

acil yardım!!!

 

[askm]

Aşağıdaki kodlar işinize yarar mı? Örnek dosya olsa daha iyi olacak.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("j5")) Is Nothing Then
        Columns("N:DE").EntireColumn.Hidden = True
    ElseIf Not Intersect(Target, Range("k5")) Is Nothing Then
        Columns("M:DE").EntireColumn.Hidden = True
    ElseIf Not Intersect(Target, Range("k5")) Is Nothing Then
        Columns("O:DE").EntireColumn.Hidden = True
    End If
End Sub

 

[yusuf09]

deniyorum olmazsa dosyayı yüklerim

 

[yusuf09]

http://s3.dosya.tc/server11/5vipe8/TAKIP.xlsx.html


J5 İLE DE5 arasına tarih girdiğimde birkaç sütun daha göstersin değer girmek için

 

[yusuf09]

Aşağıdaki kodlar işinize yarar mı? Örnek dosya olsa daha iyi olacak.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("j5")) Is Nothing Then
        Columns("N:DE").EntireColumn.Hidden = True
    ElseIf Not Intersect(Target, Range("k5")) Is Nothing Then
        Columns("M:DE").EntireColumn.Hidden = True
    ElseIf Not Intersect(Target, Range("k5")) Is Nothing Then
        Columns("O:DE").EntireColumn.Hidden = True
    End If
End Sub

kodu denedim ilgilendiğiniz için teşekkür ederim örneği ekledim bi daha bakabilirmisiniz

 

[yusuf09]

bakabildiniz mi çözüm var mı?

 

[askm]

Belirttiğiniz siteden dosya indiremiyorum. http://www.dosyaupload.com a yüklerseniz yardımcı olmaya çalışayım.

 

[yusuf09]

http://www.dosyaupload.com/8RwF

 

[askm]

Sizin istediğiniz örneğe göre 5 satır J ile DE arasında boş olan sütunları gizlemek. Doğru mudur? Yoksa veri girilen Örneğin S5 den itibaren 3 sütun kalsın gerisi gizlensin mi?

 

[yusuf09]

evet istediğim tam olarak bu

 

[yusuf09]

özür dilerim örneğe göre 5 satır J ile DE arasında boş olan sütunları gizlemek
ancak veri girilebilmesi için sıradaki 3-5 sütunu görünür yapmak

 

[askm]

Aşağıdaki kodları sayfanın kod bölümüne ekleyip deneyin.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim a As Integer
gosterr
On Error Resume Next
For a = 19 To 106
    If Cells(5, a) <> 0 Then
        Columns(a).Hidden = False
    Else
        Columns(a + 3).Hidden = True
    End If
Next a

End Sub
Sub gosterr()
Columns.Hidden = False
End Sub

 

[yusuf09]

teşekkür ederim makro çalışıyor ancak

denediniz mi bilmiyorum ama başka bir problem oluştu

 

[yusuf09]

herhangi bir hücreye tıkladığımda sütunlar açılıyor tekrar kapanıyor.

işleri kolaylaştıralım derken işlem yapılmaz hale geldi buna bir çözüm var mı?

çözüm yoksa otomatik şütun ekleme sorunu çözer mi?

 

[askm]

Aşağıdaki şekilde deneyin. Yalnız 5. satırda j5:de5 aralığında veri girdiğinizde ya tab ile geçin ya da enter ile alt satıra geçip tekrar yukarı çıkınca çalışıyor.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim a As Integer
If Not Intersect(Target, Range("j5:DE5")) Is Nothing Then
gosterr
On Error Resume Next
For a = 19 To 106
    If Cells(5, a) <> 0 Then
        Columns(a).Hidden = False
    Else
        Columns(a + 3).Hidden = True
    End If
Next a
End If
End Sub

 

[yusuf09]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

yazılı satır sarı uyarı verdi

 

[yusuf09]

This command will stop the debugger.

 

[askm]

Örnek dosyanız ektedir. Bende hata vermiyor.

 

[yusuf09]

sütun ekleme makrosunu denesek nasıl olur?