Автор Тема: Excel VBA: Автоматическое прибавление чисел в отфильтрованные строки с помощью макроса.  (Прочитано 53 раз)

Оффлайн ulitkamo

  • Посетитель форума
  • Сообщений: 2
В таблице есть 100 строк и 10 столбцов. Применяется фильтрация по параметрам, после этого остаются видимы 5 строк. Возможно ли написать макрос, который в видимые строки в определенный столбец во все 5 строк будет прибавлять по 1?

Оффлайн Администратор

  • Administrator
  • Сообщений: 1574
Макрос
Sub Макрос()

    Dim rng_AF As Range, vis As Range, ar As Range
    Dim i As Long
   
   
    ' Отключение монитора, чтобы ускорить макрос. Можно ещё отключить пересчёт формул.
    Application.ScreenUpdating = False
   
    '1. Присваиваем фрагменту, с которым работает автофильтр, имя 'rng_AF'. Далее в коде будем обращаться к этому фрагменту
        ' по имени 'rng_AF'. Может быть так будет удобнее писать и читать код.
    Set rng_AF = ActiveSheet.AutoFilter.Range
   
    '2. Убираем из фрагмента первую строку, т.к. это шапка. Чтобы было проще написать код.
    Set rng_AF = rng_AF.Rows("2:" & rng_AF.Rows.Count)
   
    '3. Присваиваем видимым строкам имя 'vis'. Далее в коде будем обращаться к видимым строкам,
        ' используя имя 'vis'. Если скрыты все строки, то произойдёт run-ошибка, которая
        ' остановит макрос. Чтобы не было остановки макроса, команда помещается внутрь
        ' перехватчика ошибок.
    On Error Resume Next
    Set vis = rng_AF.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
   
    '4. Если все строки скрыты, то в переменной 'vis' будет текст 'Nothing'.
    If vis Is Nothing Then
        Application.ScreenUpdating = True
        MsgBox "Готово.", vbInformation
        Exit Sub
    End If
   
    '5. Двигаемся по видимым областям. Области образуются, если между видимыми строками,
        ' есть невидимые строки.
    For Each ar In vis.Areas
        ' Двигаемся по строкам области.
        For i = 1 To ar.Rows.Count
            ' Изменяем данные в видимой строке.
            ar.Cells(i, "B").Value = ar.Cells(i, "B").Value + 1
        Next i
    Next ar
   
    ' Включение монитора.
    Application.ScreenUpdating = True
   
    '7. Сообщение.
    MsgBox "Готово.", vbInformation

End Sub

Оффлайн ulitkamo

  • Посетитель форума
  • Сообщений: 2
Спасибо за ответ. Сам нашёл решение:
Sub w()
    For i = 2 To Cells(Rows.Count, 11).End(xlUp).Row
       If Range("K" & i).EntireRow.Hidden = False Then
          Range("K" & i).Value = Val(Range("K" & i)) + 1
       End If
    Next
End Sub