Дано: есть выгруженные из САП расчетные листки в жутком виде (масса пустых строк и никаких разрывов страниц)
Задача: Привести к печатному виду: удалить лишние строки и поместить по 2 расчетных листка на страницу
Решение:
Sub clear_empty_lines()
Dim r As Long, FirstRow As Long, LastRow As Long
npb = 0
FirstRow = ActiveSheet.UsedRange.Row
LastRow = ActiveSheet.UsedRange.Rows.Count - 1 + ActiveSheet.UsedRange.Row
For r = FirstRow To LastRow - 1 Step 1
If TypeName(Cells(r, 1).Value) = "String" Then
If InStr(Cells(r, 1), "Расчетный листок") <> 0 Then
If (npb = 2) Then
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Rows(r)
npb = 1
Else
npb = npb + 1
End If
End If
End If
If Application.CountA(Rows(r)) = 0 Then
If Application.CountA(Rows(r + 1)) = 0 Then
Rows(r + 1).Hidden = True
End If
End If
Next r
End Sub
Задача: Привести к печатному виду: удалить лишние строки и поместить по 2 расчетных листка на страницу
Решение:
Sub clear_empty_lines()
Dim r As Long, FirstRow As Long, LastRow As Long
npb = 0
FirstRow = ActiveSheet.UsedRange.Row
LastRow = ActiveSheet.UsedRange.Rows.Count - 1 + ActiveSheet.UsedRange.Row
For r = FirstRow To LastRow - 1 Step 1
If TypeName(Cells(r, 1).Value) = "String" Then
If InStr(Cells(r, 1), "Расчетный листок") <> 0 Then
If (npb = 2) Then
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Rows(r)
npb = 1
Else
npb = npb + 1
End If
End If
End If
If Application.CountA(Rows(r)) = 0 Then
If Application.CountA(Rows(r + 1)) = 0 Then
Rows(r + 1).Hidden = True
End If
End If
Next r
End Sub
