• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Sütun gizleme makrosu yardım

Merhaba.

Alternatif olsun. Umarım yanlış anlamadım.
Aşağıdaki kod'u ilgili sayfanın kod bölümüne yapıştırın.
(Varsa eski kodları silin)
.
Kod: 
[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
If Intersect(Target, [J5:DE9]) Is Nothing Then Exit Sub
[COLOR="red"]Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual[/COLOR]
If Cells(5, Target.Column) <> "" Then Columns(Target.Column + 1).EntireColumn.Hidden = False
For sut = 109 To 11 Step -1
    If Cells(5, sut - 1) = "" Then Columns(sut).EntireColumn.Hidden = True
Next
Cells(5, [DF5].End(1).Column + 1).Activate
[COLOR="Red"]Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic[/COLOR]
[B]End Sub[/B]
 
Ömer BARAN' Alıntı:
Merhaba.

Alternatif olsun. Umarım yanlış anlamadım.
Aşağıdaki kod'u ilgili sayfanın kod bölümüne yapıştırın.
(Varsa eski kodları silin)
Başka bir sayfaya geçip, asıl sayfaya dönün ve belirttiğiniz alana veri yazarak deneyin.
.
Kod: 
[B]Private Sub Worksheet_Activate()[/B]
For sut = 109 To 11 Step -1
    If Cells(5, sut - 1) = "" Then Columns(sut).EntireColumn.Hidden = True
Next
[B]End Sub[/B]

[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
If Intersect(Target, [J5:DE9]) Is Nothing Then Exit Sub
If Target <> "" Then Columns(Target.Column + 1).EntireColumn.Hidden = False
[B]End Sub[/B]
Genişletmek için tıkla ...


bu çalışıyor. ufak bir hatayla karşılaştım düzelteblirsek memnun olurum.

girdiğimiz tarihlerin birkaçını birden silmek istediğimde bir mesaj geliyor ve kod sayfasına atıyor
 
Tekrar merhaba.

Önceki cevabımı güncelledim, sayfayı yenileyerek kortrol edin.
Önceki cevabımda verdiğim Private Sub Worksheet_Activate() kod blokunu silip,
sadece verdiğim yeni kod blokunu kullanarak deneyin.
.
 
Ömer BARAN' Alıntı:
Tekrar merhaba.

Önceki cevabımı güncelledim, sayfayı yenileyerek kortrol edin.
Önceki cevabımda verdiğim Private Sub Worksheet_Activate() kod blokunu silip,
sadece verdiğim yeni kod blokunu kullanarak deneyin.
.
Genişletmek için tıkla ...

merhaba

emeğinize sağlık kod sorunsuz çalışıyor.

bir sorum daha olacak bu kod çalışırken sayfada git-geller oluyor sanırım makro çok sütunda çalışıyor ondan bunun için bir çözümünüz var mı?

yoksa bile bu hali yeterli.
 
Önceki cevabıma eklediğim kırmızı renklendirdiğim satırları eklerseniz sorun kalmaması lazım.
 
dediğiniz gibi sorun kalmadı
öncelikle size ve diğer ilgilenen arkadaşlara, emekleriniz için çok teşekkür ederim.
 
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual

Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic



bu kodlar ne işe yarar diğer sayfalarda da git-gel sıkıntısı çekiyorum bu kodlar iş görür mü?
 
Application.ScreenUpdating = False ekran güncellemeyi kapatır. (True olunca açar.)
Application.Calculation = xlCalculationManual Hesaplama işlemlerini manuel yapar. Örneğin C1 hücresinde A1+B1 yaptınız. A1 deki rakamı değiştirince C1 sonuç değişmesi gerek. Ama değişmez. Anca F2 ile hücre içerisine girince değişir. (xlCalculationAutomatic olunca otomatik olur. Burda A1 değiştirince C1 otomatik değişir. )
Yani bu işlemler makro çalışırken etkilenen hücreleri geçici olarak donduruyor. Sonra eski haline alıyor gibi düşünebilirsiniz.
 
Private Sub Worksheet_Activate()
Sheets("Mal-Hizmet Bilgileri").Unprotect "123"
On Error Resume Next
Dim bul As Range
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
For Each bul In Range("a7:a505")
If bul.Value = Empty Then
Rows(bul.Row).Hidden = True
Else
Rows(bul.Row).Hidden = False
End If
Next bul
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
If (Range("H3").Value) = "" Then
Columns("H:H").ColumnWidth = 3
Else
Columns("H:H").ColumnWidth = 15
End If
If (Range("I3").Value) = "" Then
Columns("I:I").ColumnWidth = 3
Else
Columns("I:I").ColumnWidth = 15
End If
If (Range("N3").Value) = "" Then
Columns("N:N").ColumnWidth = 3
Else
Columns("N:N").ColumnWidth = 15
End If
If (Range("O3").Value) = "" Then
Columns("O:O").ColumnWidth = 3
Else
Columns("O:O").ColumnWidth = 15
End If


Dim i As Long



For i = 7 To 506
With Range("E" & i & ":I" & i)
If Cells(i, "A") <> "" And Cells(i, "D") = "" Then
.Locked = True
.FormulaHidden = True
Else
.Locked = False
.FormulaHidden = False
End If
End With
Next i







For i = 7 To 506
With Range("K" & i & ":O" & i)
If Cells(i, "A") <> "" And Cells(i, "D") = "" Then
.Locked = True
.FormulaHidden = True
Else
.Locked = False
.FormulaHidden = False
End If
End With
Next i



Sheets("Mal-Hizmet Bilgileri").Protect "123"
End Sub
Genişletmek için tıkla ...


cevabınız için tesekkürler. böyle bir kodum var çalışmasında ekran donmaları oluyor düzeltme yapılabilir mi?
 
Tekrar merhaba.

Son cevabınızda belirttiğiniz ve yavaş çalışan kodlar ve formüller içerisinde olacak şekilde bir
örnek belge yüklerseniz daha net cevaplar vermek mümkün olur diye düşünüyorum.
(alandaki formüller benzer yapıda ise birkaç satırlık örnek veri ve bu verilere göre işlem yapan formüllerin içinde olması yeterli)
.
 
Umarım yanlış anlamadım.

-- Alt taraftan Mal-Hizmet Bilgileri adlı sayfanın adına farayla sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- Açılan VBA ekranında sağ taraftaki alanda yer alan (son cevabınızda verdiğiniz) kodların tümünü silip yerine aşağıdaki kod blokunu yapıştırın,
-- Sayfadaki korumayı kaldırın ve gizli satırların tümünü görünür hale getirip sayfaya 123 şifresini kullanarak korumayı aktifleştirin,
-- Belgede başka bir sayfaya geçin ve tekrar Mal-Hizmet Bilgileri adlı sayfaya dönün.
-- İşlem hızının oldukça artması gerekir.
-- Sonuç alamazsanız, bir önceki cevabımda belirttiğim gibi; örnek belge yükleyin onun üzerinden bakalım.

-- Kırmızı renklendirdiğim satırları silin,
-- Mavi renklendirdiğim satırları ekleyin.
.
Kod: 
[B]Private Sub Worksheet_Activate()[/B]
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Sheets("Mal-Hizmet Bilgileri").Unprotect "123"
[COLOR="Blue"][B]Rows.Hidden = False
Rows(WorksheetFunction.Count(Sheets("İhale Malzemeleri").Range("I:I")) + 7 & ":" & 501).Hidden = True[/B][/COLOR]
[COLOR="Red"]    For sat = 7 To 505
        If Cells(sat, 1) = "" Then Rows(sat).Hidden = True
    Next[/COLOR]
    Columns("H:I").ColumnWidth = 15
If (Range("H3").Value) = "" Then Columns("H:H").ColumnWidth = 3
If (Range("I3").Value) = "" Then Columns("I:I").ColumnWidth = 3
    Columns("N:O").ColumnWidth = 15
If (Range("N3").Value) = "" Then Columns("N:N").ColumnWidth = 3
If (Range("O3").Value) = "" Then Columns("O:O").ColumnWidth = 3
Range("D7:D505").Locked = True
Range("D7:D505").FormulaHidden = True
Range("K7:O505").Locked = True
Range("K7:O505").FormulaHidden = True
For Each hucre In Range("D7:D505").SpecialCells(xlCellTypeVisible)
    If hucre <> "" Then
        Range("E" & hucre.Row & ":I" & hucre.Row).Locked = False
        Range("E" & hucre.Row & ":I" & hucre.Row).FormulaHidden = False
        Range("K" & hucre.Row & ":O" & hucre.Row).Locked = False
        Range("K" & hucre.Row & ":O" & hucre.Row).FormulaHidden = False
    End If
Next
Sheets("Mal-Hizmet Bilgileri").Protect "123"
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
[B]End Sub[/B]
 
cevabınızı yeni farkettim tesekkür ederim deniyorum hemen dosya linki de ekte gizli satırlar vs var bilginiz olsun
 
Sütun gizlemek için alternatif olarak aşağıdaki kodu da kullanabilirsiniz.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("J5:DE5")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Range("J:DE").EntireColumn.Hidden = True
    Target.Resize(, 5).EntireColumn.Hidden = False
    Application.ScreenUpdating = True
End Sub
 
gönderdiğiniz kodlarda satır gizleme yapıyor ancak satırlarda değişiklik olduğunda (diğer sayfalardaki değişken neticesinde) satır gösterme aktif hale gelmiyor.

a 7-506 arası değer varsa satır görünür değer yoksa satır gizle yapmaya çalışıyorum onun dışında benim kodlardaki kilitlenme sorunu kalmadı
 
Diğer sayfaya geçip tekrar ilgili sayfaya döndüğünüzde sonuç almanız lazım.
Formüller Mal-Hizmet .... sayfasındaki bir değişime göre mi değer üretiyor, onu anlayamadım.
Örnek belgenizde A sütununda yer alan formüller #BAŞV# hatası içeriyor.

Sanırım yine gerçek belgeyle aynı yapıda ve formüller çalışır durumda bir örnek belge olmama durumuyla karşı karşıyayız.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst