Değeri sıfır olan satırları makro ile gizleme

[vuranoğlu]

Ek teki örnekte olduğu gibi hazırlanan sayfalarda ki verileri önizleme ve yazdırma esnasında gözükmemesi için
nasıl bir makro gerekir.?
Teşekkürler.

 

[Ömer]

Merhaba,

Deneyiniz.

Sub Yazdir()

    Dim sat As Long

    Call Gizle 'ilave

    sat = [A:K].Find("*", , , , xlByRows, xlPrevious).Row

    ActiveSheet.PageSetup.PrintArea = "$A$1:$K$" & sat
    ActiveSheet.PrintOut

    Cells.EntireRow.Hidden = False 'ilave

End Sub


Sub Gizle() 'ilave

    Dim i As Long, c As Range, t As Double

    Application.ScreenUpdating = False
    Cells.EntireRow.Hidden = False

    For i = 3 To Cells(Rows.Count, "A").End(xlUp).Row
        t = WorksheetFunction.Sum(Cells(i, "B").Resize(1, 6))
        If t = 0 Then
            If c Is Nothing Then
                Set c = Rows(i)
            Else
                Set c = Application.Union(c, Rows(i))
            End If
        End If
    Next i

    c.EntireRow.Hidden = True
    Application.ScreenUpdating = True

End Sub

 

[vuranoğlu]

Sayın Ömer
Teşekkür ederim.
Ön izleme ve yazdırma dan sonra sayfa eski haline dönebilir mi?

 

[Ömer]

Dönüyor olması gerekir. Yazdır kodunun sonuna ilave etmiştim.

 

[vuranoğlu]

Teşekkürler.

 

[vuranoğlu]

İyi akşamlar.
Yukarıdaki kodlarla düzenlenen tablolarda( birleştirilmiş hücrelerde )hücreler filitreleniyor.

 

[vuranoğlu]

Merhaba
Ömer beyin vermiş olduğu
aşağıdaki kodlarla birleştirilmiş hücrelerde
sonuç alamıyorum.



Sub Yazdir()

Dim sat As Long

Call Gizle 'ilave

sat = [A:K].Find("*", , , , xlByRows, xlPrevious).Row

ActiveSheet.PageSetup.PrintArea = "$A$1:$K$" & sat
ActiveSheet.PrintOut

Cells.EntireRow.Hidden = False 'ilave

End Sub


Sub Gizle() 'ilave

Dim i As Long, c As Range, t As Double

Application.ScreenUpdating = False
Cells.EntireRow.Hidden = False

For i = 3 To Cells(Rows.Count, "A").End(xlUp).Row
t = WorksheetFunction.Sum(Cells(i, "B").Resize(1, 6))
If t = 0 Then
If c Is Nothing Then
Set c = Rows(i)
Else
Set c = Application.Union(c, Rows(i))
End If
End If
Next i

c.EntireRow.Hidden = True
Application.ScreenUpdating = True

End Sub

 

[Ömer]

Merhaba,

Gizle kodlarını aşağıdakilerle değiştirerek deneyiniz.

Sub Gizle() 'ilave

    Dim i As Long, c As Range, t As Double

    Application.ScreenUpdating = False
    Cells.EntireRow.Hidden = False

    For i = 4 To 129 Step 2 'Cells(Rows.Count, "A").End(xlUp).Row
        t = WorksheetFunction.Sum(Cells(i, "C").Resize(1, 6))
        If t = 0 Then
            If c Is Nothing Then
                Set c = Rows(i).Resize(2, 1)
            Else
                Set c = Application.Union(c, Rows(i).Resize(2, 1))
            End If
        End If
    Next i

    c.EntireRow.Hidden = True
    Application.ScreenUpdating = True
    ActiveWindow.SelectedSheets.PrintPreview
End Sub

 

[vuranoğlu]

Ömer Bey
Elinize sağlık.
Teşekkürler.