Нужна помощь с привязкой функции и не только (Excel VBA)

[lutorius]

Добрый день

Имеется функция

Sub HideEmptyRows() 
Dim r As Long, FirstRow As Long, LastRow As Long 
FirstRow = ActiveSheet.UsedRange.Row 
LastRow = ActiveSheet.UsedRange.Rows.Count - 1 + ActiveSheet.UsedRange.Row 
   For r = LastRow To FirstRow Step -1 
       If Application.CountA(Rows®) = 0 Then 
           Rows®.Hidden = True 
           Else 
           Rows®.Hidden = False 
       End If 
   Next r 
End Sub

Как ее привязать к отдельным листам и указать в ней строки, которые не надо скрывать на этих листах?
(Строки на каждом листе разные)

Спасибо


_____
Код программы нужно выделять (форматировать) тегами [CODE] (читать FAQ)
Модератор

[Aleksandr H.]

Sub HideEmptyRows()
Dim r As Long, FirstRow As Long, LastRow As Long
dim s as string
dim a() as string
s="Лист1,Лист2"
a=split(s,",")

For i = LBound(A) To UBound(A)
              
 with a(i)       
 FirstRow = .UsedRange.Row
 LastRow = .UsedRange.Rows.Count - 1 + .UsedRange.Row
 For r = LastRow To FirstRow Step -1
  If Application.CountA(.Rows®) = 0 Then
   .Rows®.Hidden = True
  Else
   .Rows®.Hidden = False
  End If
 Next r
 end with
Next i
End Sub

[Serge_Bliznykov]

извините за оффтоп. а что это за значок "®" после .Rows ?
code.png

[IgorGO]

Сергей это

Rows(r)

если код обрамлять тегом код, то

0;) будет выглядеть как 0;)

а не 0 в тексте сообщения

[Serge_Bliznykov]

Сообщение от IgorGO

Сергей это

Rows(r)

Теперь всё понятно. спасибо.

[lutorius]

Сообщение от Aleksandr H.

Sub HideEmptyRows()
Dim r As Long, FirstRow As Long, LastRow As Long
dim s as string
dim a() as string
s="Лист1,Лист2"
a=split(s,",")

For i = LBound(A) To UBound(A)
              
 with a(i)       
 FirstRow = .UsedRange.Row
 LastRow = .UsedRange.Rows.Count - 1 + .UsedRange.Row
 For r = LastRow To FirstRow Step -1
  If Application.CountA(.Rows®) = 0 Then
   .Rows®.Hidden = True
  Else
   .Rows®.Hidden = False
  End If
 Next r
 end with
Next i
End Sub

А можно пояснить что тут что? Я не разбираюсь в программировании
Например на первом листе не надо скрывать строки с 1 по 5 включительно, а на втором 7-ю и 16-ю
Спасибо

[IgorGO]

Sub HideEmptyRowsExclus()
  Dim ws&, Exc&(1 To 2, 1 To 16), Excs, i&, hd As Boolean
  Excs = Array(1, 2, 3, 4, 5) ' исключения на 1-м листе
  For i = LBound(Excs) To UBound(Excs): Exc(1, Excs(i)) = 1: Next
  Excs = Array(7, 16)         ' исключения на 2-м листе
  For i = LBound(Excs) To UBound(Excs): Exc(2, Excs(i)) = 1: Next
  For ws = 1 To 2
    With Worksheets(ws)
      For r = 1 To .UsedRange.Rows.Count - 1 + UsedRange.Row
        If r > 16 Then hd = True Else hd = Exc(ws, r) = 0
        .Rows(r).Hidden = WorksheetFunction.CountA(.Rows(r)) = 0 And hd
      Next
    End With
  Next
End Sub

[lutorius]

Спасибо на винде работает, но вот на маке не хочет. В чем может быть проблема?

Sub HideEmptyRows()
  Dim i As Long, row As Long, firstRow As Long, lastRow As Long

 Dim excludeRows()
  excludeRows = Array(Array(1, 2, 3, 4, 5, 9, 17, 40), Array(1, 2, 3, 4, 5, 28), Array(1, 2, 3, 4, 5, 74), Array(1, 2, 3, 4, 5, 510))
  
 Dim sheets()
  sheets = Array("Summary", "Carline", "Variant", "Area - Carline")

For i = LBound(sheets) To UBound(sheets)

  With Worksheets(sheets(i))
    
  firstRow = .UsedRange.row
   lastRow = .UsedRange.Rows.Count - 1 + .UsedRange.row
    
  For row = lastRow To firstRow Step -1
      If (IsError(Application.Match(row, excludeRows(i), 0))) Then
        If Application.WorksheetFunction.CountA(.Rows(row)) = 0 Then
          .Rows(row).Hidden = True
        Else
          .Rows(row).Hidden = False
        End If
      End If
    Next row
    
  End With
  Next i


End Sub

Это итоговый код, который записан в модуле. На каждой странице есть такой триггер на запуск этой функции:

Private Sub Worksheet_PivotTableChangeSync(ByVal Target As PivotTable)

Call HideEmptyRows

End Sub

Но на маке такая схема не хочет работать

[IgorGO]

проблема может быть в несовместимости
высылайте мне МАК
я Вам вышлю работающий код

[lutorius]

Пробелма решена. Тему можно закрыть