Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/CounIf для отфильтрованного диапазона - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » CounIf для отфильтрованного диапазона (Макросы/Sub)
CounIf для отфильтрованного диапазона
Xpert Дата: Вторник, 22.02.2022, 13:58 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 103
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Всем привет!
Просьба подсказать, существуют ли какие-нибудь варианты применения функции CountIf в VBA таким образом, чтобы считались только видимые ячейки?
Накропал макрос, но он не работает при использовании фильтра.
[vba]
Код

Sub ttt()
    Dim lrw&, plsd&, rs&, dcl&, prch&, Rng As Range
    With Лист1
        lrw = .Range("A" & Rows.Count).End(xlUp).Row
        Set Rng = .Range("A2:A" & lrw).SpecialCells(xlVisible)
        plsd = Application.WorksheetFunction.CountIf(Rng, "Order placed")
        rs = Application.WorksheetFunction.CountIf(Rng, "Under consideration") + Application.WorksheetFunction.CountIf(Rng, "Under Customer's review") + Application.WorksheetFunction.CountIf(Rng, "Technical evaluation")
        dcl = Application.WorksheetFunction.CountIf(Rng, "Rejected*") + Application.WorksheetFunction.CountIf(Rng, "*unacceptable")
        prch = Application.WorksheetFunction.CountIf(Rng, "*hold") + Application.WorksheetFunction.CountIf(Rng, "*refused*")
        .Range("D1") = "На рассмотрении: " & rs
        .Range("G1") = "Реализовано: " & plsd
        .Range("J1") = "Отклонено: " & dcl
        .Range("M1") = "Прочие: " & prch
        With .Range("D1")
            .Font.Color = -3407872
            .Font.Bold = True
        End With
        With .Range("G1")
            .Font.Color = -16776961
            .Font.Bold = True
        End With
        With .Range("J1")
            .Font.Color = -11489280
            .Font.Bold = True
        End With
    End With
End Sub
[/vba]

Пример прилагаю.
К сообщению приложен файл: 7621713.xlsm(20.4 Kb)
 
Ответить
СообщениеВсем привет!
Просьба подсказать, существуют ли какие-нибудь варианты применения функции CountIf в VBA таким образом, чтобы считались только видимые ячейки?
Накропал макрос, но он не работает при использовании фильтра.
[vba]
Код

Sub ttt()
    Dim lrw&, plsd&, rs&, dcl&, prch&, Rng As Range
    With Лист1
        lrw = .Range("A" & Rows.Count).End(xlUp).Row
        Set Rng = .Range("A2:A" & lrw).SpecialCells(xlVisible)
        plsd = Application.WorksheetFunction.CountIf(Rng, "Order placed")
        rs = Application.WorksheetFunction.CountIf(Rng, "Under consideration") + Application.WorksheetFunction.CountIf(Rng, "Under Customer's review") + Application.WorksheetFunction.CountIf(Rng, "Technical evaluation")
        dcl = Application.WorksheetFunction.CountIf(Rng, "Rejected*") + Application.WorksheetFunction.CountIf(Rng, "*unacceptable")
        prch = Application.WorksheetFunction.CountIf(Rng, "*hold") + Application.WorksheetFunction.CountIf(Rng, "*refused*")
        .Range("D1") = "На рассмотрении: " & rs
        .Range("G1") = "Реализовано: " & plsd
        .Range("J1") = "Отклонено: " & dcl
        .Range("M1") = "Прочие: " & prch
        With .Range("D1")
            .Font.Color = -3407872
            .Font.Bold = True
        End With
        With .Range("G1")
            .Font.Color = -16776961
            .Font.Bold = True
        End With
        With .Range("J1")
            .Font.Color = -11489280
            .Font.Bold = True
        End With
    End With
End Sub
[/vba]

Пример прилагаю.

Автор - Xpert
Дата добавления - 22.02.2022 в 13:58
Pelena Дата: Вторник, 22.02.2022, 14:23 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 18555
Репутация: 4202 ±
Замечаний: ±

Excel 2016 & Mac Excel
Вроде работает. Сначала фильтр, потом макрос


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеВроде работает. Сначала фильтр, потом макрос

Автор - Pelena
Дата добавления - 22.02.2022 в 14:23
Xpert Дата: Вторник, 22.02.2022, 14:27 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 103
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Pelena, при фильтрации по дате выдаёт ошибку.
К сообщению приложен файл: 1831630.jpg(39.9 Kb)


Сообщение отредактировал Xpert - Вторник, 22.02.2022, 14:32
 
Ответить
СообщениеPelena, при фильтрации по дате выдаёт ошибку.

Автор - Xpert
Дата добавления - 22.02.2022 в 14:27
Pelena Дата: Вторник, 22.02.2022, 14:35 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 18555
Репутация: 4202 ±
Замечаний: ±

Excel 2016 & Mac Excel
Попробуйте так
[vba]
Код
Sub ttt()
    Dim lrw&, plsd&, rs&, dcl&, prch&, Rng As Range
    With Лист1
        lrw = .Range("A" & Rows.Count).End(xlUp).Row
        For Each Rng In .Range("A2:A" & lrw).SpecialCells(xlVisible).Areas
            plsd = plsd + Application.WorksheetFunction.CountIf(Rng, "Order placed")
            rs = rs + Application.WorksheetFunction.CountIf(Rng, "Under consideration") + Application.WorksheetFunction.CountIf(Rng, "Under Customer's review") + Application.WorksheetFunction.CountIf(Rng, "Technical evaluation")
            dcl = dcl + Application.WorksheetFunction.CountIf(Rng, "Rejected*") + Application.WorksheetFunction.CountIf(Rng, "*unacceptable")
            prch = prch + Application.WorksheetFunction.CountIf(Rng, "*hold") + Application.WorksheetFunction.CountIf(Rng, "*refused*")
        Next Rng
        .Range("D1") = "На рассмотрении: " & rs
        .Range("G1") = "Реализовано: " & plsd
        .Range("J1") = "Отклонено: " & dcl
        .Range("M1") = "Прочие: " & prch
        With .Range("D1")
            .Font.Color = -3407872
            .Font.Bold = True
        End With
        With .Range("G1")
            .Font.Color = -16776961
            .Font.Bold = True
        End With
        With .Range("J1")
            .Font.Color = -11489280
            .Font.Bold = True
        End With
    End With
End Sub
[/vba]


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеПопробуйте так
[vba]
Код
Sub ttt()
    Dim lrw&, plsd&, rs&, dcl&, prch&, Rng As Range
    With Лист1
        lrw = .Range("A" & Rows.Count).End(xlUp).Row
        For Each Rng In .Range("A2:A" & lrw).SpecialCells(xlVisible).Areas
            plsd = plsd + Application.WorksheetFunction.CountIf(Rng, "Order placed")
            rs = rs + Application.WorksheetFunction.CountIf(Rng, "Under consideration") + Application.WorksheetFunction.CountIf(Rng, "Under Customer's review") + Application.WorksheetFunction.CountIf(Rng, "Technical evaluation")
            dcl = dcl + Application.WorksheetFunction.CountIf(Rng, "Rejected*") + Application.WorksheetFunction.CountIf(Rng, "*unacceptable")
            prch = prch + Application.WorksheetFunction.CountIf(Rng, "*hold") + Application.WorksheetFunction.CountIf(Rng, "*refused*")
        Next Rng
        .Range("D1") = "На рассмотрении: " & rs
        .Range("G1") = "Реализовано: " & plsd
        .Range("J1") = "Отклонено: " & dcl
        .Range("M1") = "Прочие: " & prch
        With .Range("D1")
            .Font.Color = -3407872
            .Font.Bold = True
        End With
        With .Range("G1")
            .Font.Color = -16776961
            .Font.Bold = True
        End With
        With .Range("J1")
            .Font.Color = -11489280
            .Font.Bold = True
        End With
    End With
End Sub
[/vba]

Автор - Pelena
Дата добавления - 22.02.2022 в 14:35
Xpert Дата: Вторник, 22.02.2022, 16:02 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 103
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Pelena,
Елена, спасибо огромное, работает как надо!
Если не затруднит, поясните, пожалуйста, в чём фокус?


Сообщение отредактировал Xpert - Вторник, 22.02.2022, 16:03
 
Ответить
СообщениеPelena,
Елена, спасибо огромное, работает как надо!
Если не затруднит, поясните, пожалуйста, в чём фокус?

Автор - Xpert
Дата добавления - 22.02.2022 в 16:02
Pelena Дата: Вторник, 22.02.2022, 16:37 | Сообщение № 6
Группа: Админы
Ранг: Местный житель
Сообщений: 18555
Репутация: 4202 ±
Замечаний: ±

Excel 2016 & Mac Excel
в чём фокус?

при фильтрации и использовании только видимых ячеек в общем случае у нас получается не непрерывный диапазон строк, а несколько областей (areas), поэтому пришлось сделать цикл по этим областям, в каждой отдельно посчитать CountIf и просуммировать


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщение
в чём фокус?

при фильтрации и использовании только видимых ячеек в общем случае у нас получается не непрерывный диапазон строк, а несколько областей (areas), поэтому пришлось сделать цикл по этим областям, в каждой отдельно посчитать CountIf и просуммировать

Автор - Pelena
Дата добавления - 22.02.2022 в 16:37
Мир MS Excel » Вопросы и решения » Вопросы по VBA » CounIf для отфильтрованного диапазона (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2022 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!