• DİKKAT

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

Ayrı ayrı sayfalarda istenilen satır aralığında Satır Gizleme

E

ebedyolcusu

Katılım
9 Ekim 2009
Mesajlar
56
Excel Vers. ve Dili
2010
Merhabalar
Forumdan bulduğum kodlar ile aşağıdaki kodlama ile belirli aralıklarda gizleme yapabiliyorum, benim istediğim 0 değerli olanları gizlememesi..

Ve bir de aşağıda ki kodları gizli göster diye iki buton yapmak istersem bunu ToggleButton ile yapabilir miyiz.

Kod: 
Sub Gizle3()
On Local Error Resume Next
Dim i As Integer
For i = 1 To Sheets.Count
Select Case Sheets(i).Name
Case Is = "Teklif Zarfları Teslim Tutanağı"
Sheets(i).Range("B18:B27").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
Case Is = "Zarf Açma İlk İnceleme"
Sheets(i).Range("B13:B22").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
Case Is = "Talep edenlere verilen Tutanak"
Sheets(i).Range("B15:B24").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
Case Is = "İstekl.Teklif Edilen Fiyatlar"
Sheets(i).Range("A14:A23").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
Case Is = "Zarf Açma Ayrıntılı"
Sheets(i).Range("B12:B21").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
Case Is = "Yeterlilik Değerlendirme"
Sheets(i).Range("A13:A22").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
Case Is = "Yeterlilik Değerlendirme"
Sheets(i).Range("A26:A35").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
Case Is = "Son Teklif Edilen Fiyatlar"
Sheets(i).Range("A14:A23").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
Case Is = "Değer.Esas Teklif Cetv."
Sheets(i).Range("A14:A23").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
Case Is = "İhale Kom.Karar Tutanağı"
Sheets(i).Range("A24:A33").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
Case Is = "İhale Kom.Karar Tutanağı"
Sheets(i).Range("A41:A45").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
End Select
Next i
i = Empty
End Sub
 
ebedyolcusu' Alıntı:
Sıfır olan satırı gizleyecek kod eklemek istiyorum ..
Genişletmek için tıkla ...
Merhaba
Kodlardaki kırmızı bölümlerdeki gibi; aşağıdaki mavi bölümleri (hücre adreslerine göre) uyarlayıp devam ettirin "0" ve boş olanları gizleyecektir.
(Değiştireceğiniz yeşil adreslerdir)
Kod: 
[SIZE="2"]Sub Gizle3()
On Local Error Resume Next
Dim i As Integer
For i = 1 To Sheets.Count
Select Case Sheets(i).Name
Case Is = "Teklif Zarfları Teslim Tutanağı"
[COLOR="Red"]With Sheets(i).Range("[COLOR="Lime"]B18:B27"[/COLOR])
.AutoFilter
.AutoFilter Field:=1, Criteria1:=Array("0", ""), Operator:=xlFilterValues
s = Array(.SpecialCells(xlCellTypeVisible).Cells.Address)
.AutoFilter
Sheets(i).Range(s(0)).EntireRow.Hidden = True
End With[/COLOR]
Case Is = "Zarf Açma İlk İnceleme"
[COLOR="Red"]With Sheets(i).Range("[COLOR="Lime"]B13:B22[/COLOR]")
.AutoFilter
.AutoFilter Field:=1, Criteria1:=Array("0", ""), Operator:=xlFilterValues
s = Array(.SpecialCells(xlCellTypeVisible).Cells.Address)
.AutoFilter
Sheets(i).Range(s(0)).EntireRow.Hidden = True
End With[/COLOR]
Case Is = "Talep edenlere verilen Tutanak"
[COLOR="Blue"]Sheets(i).Range("B15:B24").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True[/COLOR]
Case Is = "İstekl.Teklif Edilen Fiyatlar"
[COLOR="Blue"]Sheets(i).Range("A14:A23").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True[/COLOR]
Case Is = "Zarf Açma Ayrıntılı"
[COLOR="Blue"]Sheets(i).Range("B12:B21").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True[/COLOR]
Case Is = "Yeterlilik Değerlendirme"
[COLOR="Blue"]Sheets(i).Range("A13:A22").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True[/COLOR]
Case Is = "Yeterlilik Değerlendirme"
[COLOR="Blue"]Sheets(i).Range("A26:A35").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True[/COLOR]
Case Is = "Son Teklif Edilen Fiyatlar"
[COLOR="Blue"]Sheets(i).Range("A14:A23").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True[/COLOR]
Case Is = "Değer.Esas Teklif Cetv."
[COLOR="Blue"]Sheets(i).Range("A14:A23").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True[/COLOR]
Case Is = "İhale Kom.Karar Tutanağı"
[COLOR="Blue"]Sheets(i).Range("A24:A33").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True[/COLOR]
Case Is = "İhale Kom.Karar Tutanağı"
[COLOR="Blue"]Sheets(i).Range("A41:A45").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True[/COLOR]
End Select
Next i
i = Empty
End Sub[/SIZE]

Uygulayamadıysanız kodlarınızı komple aşağıkilerle değiştirip deneyin
Kod: 
[SIZE="2"]Public s1 As Worksheet
Public x1 As String, x2 As String

Sub satgizle()
If s1.Name <> "" Then
   With s1
   If Trim(.Range(x1)) = "" Then .Range(x1) = "$$"
  .Range(x1).AutoFilter
    .Range(x2).AutoFilter Field:=1, Criteria1:="=0", Operator:=xlOr, Criteria2:="="
On Error Resume Next
    s = Array(.Range(x2).SpecialCells(xlCellTypeVisible).Cells.Address)
If Err <> 0 Then Err = 0
   .Range(x1).AutoFilter
If s(0) <> "" Then .Range(s(0)).EntireRow.Hidden = True
If Trim(.Range(x1)) = "$$" Then .Range(x1) = ""
    End With
Set s1 = Nothing
    End If
End Sub

Sub Gizle3()
Dim i As Integer
For i = 1 To Sheets.Count
Set s1 = Nothing
Set s1 = Sheets(i)
Select Case Sheets(i).Name
Case Is = "Teklif Zarfları Teslim Tutanağı"
Set s1 = Sheets(i): x1 = "B17": x2 = "B18:C27": Call satgizle
Case Is = "Zarf Açma İlk İnceleme"
Set s1 = Sheets(i): x1 = "B12": x2 = "B13:C22": Call satgizle
Case Is = "Talep edenlere verilen Tutanak"
Set s1 = Sheets(i): x1 = "B14": x2 = "B15:C24": Call satgizle
Case Is = "İstekl.Teklif Edilen Fiyatlar"
Set s1 = Sheets(i): x1 = "A13": x2 = "A14:A23": Call satgizle
Case Is = "Zarf Açma Ayrıntılı"
Set s1 = Sheets(i): x1 = "B11": x2 = "B12:B21": Call satgizle
Case Is = "Yeterlilik Değerlendirme"
Set s1 = Sheets(i): x1 = "A12": x2 = "A13:A22": Call satgizle
Case Is = "Yeterlilik Değerlendirme"
Set s1 = Sheets(i): x1 = "A25": x2 = "A26:A35": Call satgizle
Case Is = "Son Teklif Edilen Fiyatlar"
Set s1 = Sheets(i): x1 = "A13": x2 = "A14:A23": Call satgizle
Case Is = "Değer.Esas Teklif Cetv."
Set s1 = Sheets(i): x1 = "A13": x2 = "A14:A23": Call satgizle
Case Is = "İhale Kom.Karar Tutanağı"
Set s1 = Sheets(i): x1 = "A23": x2 = "A24:A33": Call satgizle
Set s1 = Sheets(i): x1 = "A40": x2 = "A41:A45": Call satgizle
End Select
Next i
i = Empty
End Sub[/SIZE]
 
Son düzenleme:
İkinci verdiğiniz kod çalışmadı, diğeri çalıştı ama sayfada ikinci satır aralığı içinde uygulayamaya çalıştığımızda onu çalıştırmadı.
 
Merhaba

Kod: 
[SIZE="2"]Case Is = [COLOR="Red"]"İhale Kom.Karar Tutanağı"[/COLOR]
Sheets(i).Range("A24:A33").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
Case Is = [COLOR="red"]"İhale Kom.Karar Tutanağı"[/COLOR]
Sheets(i).Range("A41:A45").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
End Select[/SIZE]
Yukarıdaki gibi aynı sayfa için; aşağıdaki kırmızı bölüm gibi aynı "Case Is" altında yazınki ilk bulduğundan sonra koddan çıkmasın
Şu mavi satırlarıda ekleyin "0" ve boşluk bulamadığında ilk hücre gizli kalmasın
Bir örnek dosya eklerseniz 2. kodu üzerinde uygularız o daha kısa ve uygun olacaktır www.dosya.tc
Kod: 
[SIZE="2"]Sub Gizle3()
On Local Error Resume Next
Dim i As Integer
For i = 1 To Sheets.Count
Select Case Sheets(i).Name
Case Is = "Teklif Zarfları Teslim Tutanağı"
With Sheets(i).Range("B18:B27")
.AutoFilter
.AutoFilter Field:=1, Criteria1:=Array("0", ""), Operator:=xlFilterValues
s = Array(.SpecialCells(xlCellTypeVisible).Cells.Address)
.AutoFilter
Sheets(i).Range(s(0)).EntireRow.Hidden = True
[COLOR="Blue"]If Sheets(i).Range("B18") <> "" And Sheets(i).Range("B18") <> 0 Then _
Sheets(i).Range("B18").EntireRow.Hidden = False[/COLOR]
End With

Case Is = "Zarf Açma İlk İnceleme"
With Sheets(i).Range("B13:B22")
.AutoFilter
.AutoFilter Field:=1, Criteria1:=Array("0", ""), Operator:=xlFilterValues
s = Array(.SpecialCells(xlCellTypeVisible).Cells.Address)
.AutoFilter
Sheets(i).Range(s(0)).EntireRow.Hidden = True
If Sheets(i).Range("B13") <> "" And Sheets(i).Range("B13") <> 0 Then _
Sheets(i).Range("B13").EntireRow.Hidden = False
End With

Case Is = "Talep edenlere verilen Tutanak"
With Sheets(i).Range("B15:B24")
.AutoFilter
.AutoFilter Field:=1, Criteria1:=Array("0", ""), Operator:=xlFilterValues
s = Array(.SpecialCells(xlCellTypeVisible).Cells.Address)
.AutoFilter
Sheets(i).Range(s(0)).EntireRow.Hidden = True
If Sheets(i).Range("B15") <> "" And Sheets(i).Range("B15") <> 0 Then _
Sheets(i).Range("B15").EntireRow.Hidden = False
End With


Case Is = "İstekl.Teklif Edilen Fiyatlar"
With Sheets(i).Range("A14:A23")
.AutoFilter
.AutoFilter Field:=1, Criteria1:=Array("0", ""), Operator:=xlFilterValues
s = Array(.SpecialCells(xlCellTypeVisible).Cells.Address)
.AutoFilter
Sheets(i).Range(s(0)).EntireRow.Hidden = True
If Sheets(i).Range("A14") <> "" And Sheets(i).Range("A14") <> 0 Then _
Sheets(i).Range("A14").EntireRow.Hidden = False
End With

Case Is = "Zarf Açma Ayrıntılı"
With Sheets(i).Range("B12:B21")
.AutoFilter
.AutoFilter Field:=1, Criteria1:=Array("0", ""), Operator:=xlFilterValues
s = Array(.SpecialCells(xlCellTypeVisible).Cells.Address)
.AutoFilter
Sheets(i).Range(s(0)).EntireRow.Hidden = True
If Sheets(i).Range("B12") <> "" And Sheets(i).Range("B12") <> 0 Then _
Sheets(i).Range("B12").EntireRow.Hidden = False
End With
'.......................................
Case Is = "Yeterlilik Değerlendirme"
Sheets(i).Range("A13:A22").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
Case Is = "Yeterlilik Değerlendirme"
Sheets(i).Range("A26:A35").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
Case Is = "Son Teklif Edilen Fiyatlar"
Sheets(i).Range("A14:A23").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
Case Is = "Değer.Esas Teklif Cetv."
Sheets(i).Range("A14:A23").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
'..........................................
[COLOR="Red"]Case Is = "İhale Kom.Karar Tutanağı"

With Sheets(i).Range("A24:A33")
.AutoFilter
.AutoFilter Field:=1, Criteria1:=Array("0", ""), Operator:=xlFilterValues
s = Array(.SpecialCells(xlCellTypeVisible).Cells.Address)
.AutoFilter
Sheets(i).Range(s(0)).EntireRow.Hidden = True
If Sheets(i).Range("A24") <> "" And Sheets(i).Range("A24") <> 0 Then _
Sheets(i).Range("A24").EntireRow.Hidden = False
End With

With Sheets(i).Range("A41:A45")
.AutoFilter
.AutoFilter Field:=1, Criteria1:=Array("0", ""), Operator:=xlFilterValues
s = Array(.SpecialCells(xlCellTypeVisible).Cells.Address)
.AutoFilter
Sheets(i).Range(s(0)).EntireRow.Hidden = True
If Sheets(i).Range("A41") <> "" And Sheets(i).Range("A41") <> 0 Then _
Sheets(i).Range("A41").EntireRow.Hidden = False
End With
[/COLOR]

End Select
Next i
i = Empty
End Sub






[/SIZE]
 
Eyvallah Hocam dediğiniz gibi uyguladım oldu.
Allah razı olsun.
Teşekkür ediyorum..
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst