Добрый день! Подскажите пожалуйста, есть документ КС-2. И вот такой макрос. Из месяца в месяц некоторые строки появляются с нулевыми объемами. Этим макросом не получается скрыть нулевые но оставить нужные заголовки, подскажите пожалуйста, что изменить?
Код
Dim Pos As String
Dim flag As Boolean
Sub Скрыть_только_ноль()
Application.ScreenUpdating = False
Rows.EntireRow.Hidden = False
For i = 31 To Cells(Rows.Count, 1).End(xlUp).Row
j = 1
flag = 0
'If (ActiveSheet.Cells(i, 21).Value = 0) And (ActiveSheet.CheckBoxes(1).Value = 1) Then Rows(i).EntireRow.Hidden = True ' пробую сразу скрывать
If ActiveSheet.Cells(i, 21).Value = 0 Then Rows(i).EntireRow.Hidden = True ' пробую сразу скрывать
If ActiveSheet.Cells(i, 21).Value = "" Then
'Pos = ActiveSheet.Cells(i, 3).Value
Do While InStr(1, CStr(Cells(i + j, 3)), CStr(Cells(i, 3))) = "1"
If Cells(i + j, 21) > 0 Then
flag = 1
Exit Do
End If
j = j + 1
Loop
If flag Then
Rows(i).EntireRow.Hidden = False
Else
Rows(i).EntireRow.Hidden = True
End If
End If
Next i
Application.ScreenUpdating = True
End Sub
Sub Скрыть_только_ноль()
Application.ScreenUpdating = False
Rows.EntireRow.Hidden = False
flag = True
For i = Cells(Rows.Count, 1).End(xlUp).Row To 31 Step -1
If IsEmpty(ActiveSheet.Cells(i, 21)) Then
Rows(i).EntireRow.Hidden = flag
flag = True
Else
If ActiveSheet.Cells(i, 21).Text = 0 Then
Rows(i).EntireRow.Hidden = True
Else
flag = False
End If
End If
Next i
Application.ScreenUpdating = True
End Sub