• DİKKAT

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

Satır gizleme için makro

S

ssazman

Katılım
16 Haziran 2007
Mesajlar
88
Excel Vers. ve Dili
Office 2007
Merhaba ,

Excell dosyamın içerisinde 7 sayfa var. ve bu yedi sayfanında ilk iki sutununda hep aynı veriler. Ben bu sayfadaki her bir satırdaki AD diye belitttiğim yere A veya K yazarak bunların her bir sayfadaki satırlarının Açılmasını ya da kapanmasını istiyorum. Bu şekilde excell de bir makro yazılabiliyormu? eğer yazılabiliyorsa sizden yardımlarınızı rica ediyorum
 

Ekli dosyalar

Merhaba,

Sayfalarda gizlenecek satır yada sütunlar hangileridir. Yada gizlecek olan sayfanın kendisimidir.

.
 
Ömer' Alıntı:
Merhaba,

Sayfalarda gizlenecek satır yada sütunlar hangileridir. Yada gizlecek olan sayfanın kendisimidir.

.
Genişletmek için tıkla ...

Merhaba ömer bey,
Gizlencek olan satırılardır. Fakat bu satırlar belirleyen bir paramerte var. O paremetrede excel dosyasının içerisindeki açık-kapalı sayfasında bulunan A-K harfleridir. Yani A yazınca açık, K yazınca da kapalı oluyor ve bütün diğer sayfalar da bunlar geçerli oalcak. Fakat ilerde A ( Açık) olan K (kaplı) olabilir. Kısaca şöyle dersem . Her hangi bir AD adlı stunda bulunan alipaşa-2 ismin karşı sında A varsa diğer bütün sayfalardaki Alipaşa-2 satırı açık olmalı. Eğer K varsa da tüm diğer sayfalarda satır gizli olmalı.
 
Merhaba,

Aşağıdaki kodu boş bir modüle uygulayıp denermisiniz.

Kod: 
Option Explicit
 
Sub SAYFALARDA_SATIR_GİZLE_GÖSTER()
    Dim Hücre As Range, Son_Satır As Long, Ölçüt As Boolean
    Dim Sayfa As Worksheet, Bul As Range, Adres As String, Alan As Range
    
    Application.ScreenUpdating = False
    
    With Sheets("Açık-Kapalı")
    
        Son_Satır = .Cells(Rows.Count, 2).End(3).Row
        
        For Each Sayfa In ThisWorkbook.Worksheets
            If Sayfa.Name <> "Açık-Kapalı" Then
                Sayfa.Cells.EntireRow.Hidden = False
            End If
        Next
        
        For Each Hücre In .Range("B4:B" & Son_Satır)
            If Hücre.Value <> "" Then
                If UCase(Trim(Hücre.Offset(0, 2))) = "A" Then
                    Ölçüt = False
                ElseIf UCase(Trim(Hücre.Offset(0, 3))) = "K" Then
                    Ölçüt = True
                Else
                    Ölçüt = False
                End If
                
                If Ölçüt = True Then
                
                    For Each Sayfa In ThisWorkbook.Worksheets
                        If Sayfa.Name <> "Açık-Kapalı" Then
                            Sayfa.Select
                            Set Bul = Sayfa.Range("B:B").Find(Hücre.Value, , xlValues)
                            If Not Bul Is Nothing Then
                                Adres = Bul.Address
                                Do
                                    If Alan Is Nothing Then
                                        Set Alan = Range(Bul.Address)
                                    Else
                                        Set Alan = Union(Alan, Range(Bul.Address))
                                    End If
                                Set Bul = Sayfa.Range("B:B").FindNext(Bul)
                                Loop While Not Bul Is Nothing And Bul.Address <> Adres
                            End If
                            
                            Alan.EntireRow.Hidden = Ölçüt
                            Set Alan = Nothing
                        End If
                    Next
                End If
            End If
        Next
        
        .Select
    End With
 
    Set Bul = Nothing
    
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Korhan Bey, elinize ve emeğinize sağlık. sayenizde benim için çok önemli olan bir konuda müthiş destek verdiniz. Makro yazmak bir kenara makro kaydetmeyide bilmiyordum. ama forumda İhsan Beyin. Makro kaydetme konusundaki resimli anlatımıyla onuda öğrendim.
Sizlerin sayesinde hiç bilmediğim excel ile 2007 yılında tanıştım. Kısa zamanda çok şeyler öğrendim. Heps sizleri derinden takip ettim. Bir çok uzman arkdaşın yardımlarıyla bir çok şey öğrendim. Sizlerin katkısını asla inkar edemem.

Elleriniz dert görmesin sizlerin ve sitenin takipçisiyim.
Saygılarımla

Selçuk A.
 
Korhan Ayhan' Alıntı:
Merhaba,

Aşağıdaki kodu boş bir modüle uygulayıp denermisiniz.

Kod: 
Option Explicit
 
Sub SAYFALARDA_SATIR_GİZLE_GÖSTER()
    Dim Hücre As Range, Son_Satır As Long, Ölçüt As Boolean
    Dim Sayfa As Worksheet, Bul As Range, Adres As String, Alan As Range
    
    Application.ScreenUpdating = False
    
    With Sheets("Açık-Kapalı")
    
        Son_Satır = .Cells(Rows.Count, 2).End(3).Row
        
        For Each Sayfa In ThisWorkbook.Worksheets
            If Sayfa.Name <> "Açık-Kapalı" Then
                Sayfa.Cells.EntireRow.Hidden = False
            End If
        Next
        
        For Each Hücre In .Range("B4:B" & Son_Satır)
            If Hücre.Value <> "" Then
                If UCase(Trim(Hücre.Offset(0, 2))) = "A" Then
                    Ölçüt = False
                ElseIf UCase(Trim(Hücre.Offset(0, 3))) = "K" Then
                    Ölçüt = True
                Else
                    Ölçüt = False
                End If
                
                If Ölçüt = True Then
                
                    For Each Sayfa In ThisWorkbook.Worksheets
                        If Sayfa.Name <> "Açık-Kapalı" Then
                            Sayfa.Select
                            Set Bul = Sayfa.Range("B:B").Find(Hücre.Value, , xlValues)
                            If Not Bul Is Nothing Then
                                Adres = Bul.Address
                                Do
                                    If Alan Is Nothing Then
                                        Set Alan = Range(Bul.Address)
                                    Else
                                        Set Alan = Union(Alan, Range(Bul.Address))
                                    End If
                                Set Bul = Sayfa.Range("B:B").FindNext(Bul)
                                Loop While Not Bul Is Nothing And Bul.Address <> Adres
                            End If
                            
                            Alan.EntireRow.Hidden = Ölçüt
                            Set Alan = Nothing
                        End If
                    Next
                End If
            End If
        Next
        
        .Select
    End With
 
    Set Bul = Nothing
    
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Genişletmek için tıkla ...

Koray bey,

Bu yaptığımız işlem ilk 27 satırı kapsıyor ve ondan sonrası için satır gizleme yapmıyor ve şu hatayı veriyor "object variable or with block variable not set" bu konuda yardımınızı rica ediyorum.

Selçuk,
 
Merhaba,

Kod içinde satır sınırlaması yoktur.

Hatayı verdiğinde hangi satır sarı renkli oluyor yazarmısınız.
 
Kodda sarı renk olan kısım yok
Karşıma "end-debug" hatası çıkmıyor.
sadece sarı renkli bir pencere açılıyor ve üstte yazdığım gibi "object variable or with block variable not set" diyor ve MB sayfasına otomatik olarak geçiş yapıyor. Fakat herhangi bir satırda da bilgi vermiyor.

Birde satırlardaki gizleme olduğunda RP sayfasında satır gizliyor fakat gizlediği satır ile satırın içindeki AD uyuşmuyor, yani her sayfada 15 nolu satırı kapatıyor fakat RP sayfasındaki 15 satır diğerlerinden farklı. Çünkü o sayfada veriler 13 satırdan başlarken diğer sayfalarda 4 satırdan baişlıyor.

Teşekkürler,
 
Merhaba,

Eklediğiniz dosyada yaptığım denemelerde böyle bir sorunla karşılaşmadım. Siz uyguladığınız dosyayı foruma eklermisiniz. Üzerinden gidelim.
 
Korhan Ayhan' Alıntı:
Merhaba,

Eklediğiniz dosyada yaptığım denemelerde böyle bir sorunla karşılaşmadım. Siz uyguladığınız dosyayı foruma eklermisiniz. Üzerinden gidelim.
Genişletmek için tıkla ...


Dosyayı belli bir süre çalıştırınca ve boş satırlarıda doldurunca karşıma bir hata bildirisi çıktı
" Object variable or with block variable not set"

Bu konuda yardım ederbilirmisiniz.

Emeğinize sağlık teşekkürler,
 
Son düzenleme:
Yukarıdaki hata konusunda yardım edebilirmisiniz. Dosya günceldir.

( msj kirliliği için özür dilerim )
 
Merhaba,

Aşağıdaki kodu denermisiniz.

Kod: 
Option Explicit
 
Sub SAYFALARDA_SATIR_GİZLE_GÖSTER()
    Dim Hücre As Range, Son_Satır As Long, Ölçüt As Boolean
    Dim Sayfa As Worksheet, Bul As Range, Adres As String, Alan As Range
    
    Application.ScreenUpdating = False
    
    With Sheets("Açık-Kapalı")
    
        Son_Satır = .Cells(Rows.Count, 2).End(3).Row
        
        For Each Sayfa In ThisWorkbook.Worksheets
            If Sayfa.Name <> "Açık-Kapalı" Then
                Sayfa.Cells.EntireRow.Hidden = False
            End If
        Next
        
        For Each Hücre In .Range("B4:B" & Son_Satır)
            If Trim(Hücre.Value) <> "" Then
                If UCase(Trim(Hücre.Offset(0, 2))) = "A" Then
                    Ölçüt = False
                ElseIf UCase(Trim(Hücre.Offset(0, 3))) = "K" Then
                    Ölçüt = True
                Else
                    Ölçüt = False
                End If
                
                If Ölçüt = True Then
                
                    For Each Sayfa In ThisWorkbook.Worksheets
                        If Sayfa.Name <> "Açık-Kapalı" Then
                            Sayfa.Select
                            Set Bul = Sayfa.Range("B:B").Find(Hücre.Value, , xlValues)
                            If Not Bul Is Nothing Then
                                Adres = Bul.Address
                                Do
                                    If Alan Is Nothing Then
                                        Set Alan = Range(Bul.Address)
                                    Else
                                        Set Alan = Union(Alan, Range(Bul.Address))
                                    End If
                                Set Bul = Sayfa.Range("B:B").FindNext(Bul)
                                Loop While Not Bul Is Nothing And Bul.Address <> Adres
                            End If
                            
                            If Not Alan Is Nothing Then Alan.EntireRow.Hidden = Ölçüt
                            Set Alan = Nothing
                        End If
                    Next
                End If
            End If
        Next
        
        .Select
    End With
 
    Set Bul = Nothing
    
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Korhan Ayhan' Alıntı:
Merhaba,

Aşağıdaki kodu denermisiniz.

Kod: 
Option Explicit
 
Sub SAYFALARDA_SATIR_GİZLE_GÖSTER()
    Dim Hücre As Range, Son_Satır As Long, Ölçüt As Boolean
    Dim Sayfa As Worksheet, Bul As Range, Adres As String, Alan As Range
    
    Application.ScreenUpdating = False
    
    With Sheets("Açık-Kapalı")
    
        Son_Satır = .Cells(Rows.Count, 2).End(3).Row
        
        For Each Sayfa In ThisWorkbook.Worksheets
            If Sayfa.Name <> "Açık-Kapalı" Then
                Sayfa.Cells.EntireRow.Hidden = False
            End If
        Next
        
        For Each Hücre In .Range("B4:B" & Son_Satır)
            If Trim(Hücre.Value) <> "" Then
                If UCase(Trim(Hücre.Offset(0, 2))) = "A" Then
                    Ölçüt = False
                ElseIf UCase(Trim(Hücre.Offset(0, 3))) = "K" Then
                    Ölçüt = True
                Else
                    Ölçüt = False
                End If
                
                If Ölçüt = True Then
                
                    For Each Sayfa In ThisWorkbook.Worksheets
                        If Sayfa.Name <> "Açık-Kapalı" Then
                            Sayfa.Select
                            Set Bul = Sayfa.Range("B:B").Find(Hücre.Value, , xlValues)
                            If Not Bul Is Nothing Then
                                Adres = Bul.Address
                                Do
                                    If Alan Is Nothing Then
                                        Set Alan = Range(Bul.Address)
                                    Else
                                        Set Alan = Union(Alan, Range(Bul.Address))
                                    End If
                                Set Bul = Sayfa.Range("B:B").FindNext(Bul)
                                Loop While Not Bul Is Nothing And Bul.Address <> Adres
                            End If
                            
                            If Not Alan Is Nothing Then Alan.EntireRow.Hidden = Ölçüt
                            Set Alan = Nothing
                        End If
                    Next
                End If
            End If
        Next
        
        .Select
    End With
 
    Set Bul = Nothing
    
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Genişletmek için tıkla ...


Korhan bey, elinize ve emeğinize sağlık. çok teşekkür ederim.

İki önceki msjda eklediğim dosyamı sizinde onayınızla kaldırmak isterim. malum şirkete özel bir dosya.
 
Merhaba,

Tabiki kaldırabilirsiniz.
 
Terkrar teşekkür ederim, iyi çalışmalar.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst