Хитрая группировка средствами VBA

[uni]

Методом тыка нашел ошибку.

Private Sub CommandButton2_Click()

'Dim rng As Range
     Dim grp As Range
     Dim i, j, k
     Dim adr As String
     
     
     rng = Range("A2").CurrentRegion.Rows.Count
     
    'rng.Range.Select
    Range("A2").Rows(rng).Select
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2, 3, 4, 5, _
        6), Replace:=True, PageBreaks:=False, SummaryBelowData:=False


End Sub

rng = Range("A2").CurrentRegion.Rows.Count

- эта фигня почему то не работает после того когда я очищаю ячейки (меняю формат). Подскажите каким способом можно еще найти последнюю не пустую ячейку в столбце?

[uni]

Нашел другой вариант

код

 rng = Range("a65536").End(xlUp).Ro

Вроде работает.

Теперь выполняю вот такой скрипт

Private Sub Grouping()
    Dim rgColumn As Range
    Set rgColumn = Range("A4")
 
     rng = Range("a65536").End(xlUp).Row
     
    'rng.Range.Select
    Range("A4").Rows(rng).Select
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2, 3, 4, 5, _
        6), Replace:=True, PageBreaks:=False, SummaryBelowData:=False
End Sub

Но вываливается ошибка:"Метод Select из класса Range завершен неверно"

Мне нужно что бы у меня с ячейки A4 стартовал Select.

[uni]

Private Sub Grouping()
    Dim rgColumn As Range
    Set rgColumn = Range("A4")
    
    Sheets("Лист2").Activate
     rng = Range("a65536").End(xlUp).Row
     
    'rng.Range.Select
    Sheets("Лист2").Range("A4").Rows(rng).Select
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2, 3, 4, 5, _
        6), Replace:=True, PageBreaks:=False, SummaryBelowData:=False
End Sub

Переписал, однако метод Select работает для всех строк, а мне надо с A4.

[nilem]

Таблица начинается с А4 и 1-я строка таблицы (4-я строка на листе) - заголовок. Так? Если так, то пробуем:

Private Sub CommandButton2_Click()
Dim rng As Range
Set rng = Range("A4:F" & Cells(Rows.Count, 1).End(xlUp).Row)
rng.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5, 6), _
             SummaryBelowData:=False
End Sub

[uni]

nilem
Да таблица начинается с A4:F4 и заканчивается каждый раз на разной строке.

Пробовал Ваш вариант, что то как то он у меня не вышел, выделяет не то что хотелось бы, а доработать пока не получилось.

Но я попробовал изменить свой код вот так.

Private Sub Grouping()
    Dim rgColumn As Range
'    Dim Type As XlCellType
'    Dim Value As Object
    Dim rng As Range
    Dim range1 As Range
    'Set range1 =
    
    Sheets("Ëèñò2").Activate
    'Set rng = Range("A1").SpecialCells(xlCellTypeLastCell)    'Range("a65536").End(xlUp).Row
     
    'rng.Range.Select
   Set rgColumn = ActiveSheet.Range("A4:F4").Rows(Range("A1").SpecialCells(xlCellTypeLastCell))
    rgColumn.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5, 6), _
         Replace:=True, PageBreaks:=False, SummaryBelowData:=False
End Sub

Однако он ругается:"Команда не может быть выполнена над указанным диапазоном. Выберите одну ячейку из диапазона и повторите попытку".

Когда я пишу вместо Range("A4:F4")->Range("A4") почему то берется диапазон с A1, а мне нужно с A4, так и не понял, где я не прав. Пробовал писать вот так Range(Cells(1,4)), что то там про object была ошибка.

В общем, хелп мне тоже не помог(

[uni]

В конце концов, записал вот так.

Private Sub Grouping()
    Dim rgColumn As Range
'    Dim Type As XlCellType
'    Dim Value As Object
    'Dim rng As Range
    Dim range1 As Range
    
    
    'Set range1 =
    
    Sheets("Ëèñò2").Activate
    
    
    'rng.Range.Select
Set rgColumn = Sheets("Ëèñò2").Range("A4:F65536")
    rgColumn.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5, 6), _
         Replace:=True, PageBreaks:=False, SummaryBelowData:=False
End Sub

Оказывается подсчет Итогов нормально реагирует на незаполненные строки.)

[uni]

Все таки для корректности нужно использовать в построении Итогов только те строки, которые содержат данные.

[uni]

Хз почему раньше у меня не получалось так сделать, но после того как я написал.

Private Sub Grouping()
    Dim rgColumn As Range
 
    Sheets("Лист2").Activate
    
    rng = ThisWorkbook.ActiveSheet.Columns(1).End(xlDown).Row
    
Set rgColumn = ActiveSheet.Range("A4:F" & rng)
    rgColumn.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5, 6), _
         Replace:=True, PageBreaks:=False, SummaryBelowData:=False
End Sub

Все заработало)))