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

Вход

Регистрация

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

 

= Мир MS Excel/Записать в массив только отфильтрованные ячейки - Мир MS Excel

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

Excel 2013
Всех приветствую!
Помогите, пожалуйста, с написанием макроса, который загонял бы в массив только отфильтрованные(видимые) значения.
Макрос:
[vba]
Код

Sub FltR()
Dim qarr, lrw&, i&, b#, s
With Лист1
    s = 0
        lrw = .Range("D" & Rows.Count).End(xlUp).Row
            qarr = .Range("C2:D" & lrw).SpecialCells(xlVisible)
    On Error Resume Next
        For i = LBound(qarr) To UBound(qarr)
         If qarr(i, 2) = "EUR" Then
            b = 1
            Else
            b = .Range("F1").Value
        End If
            qarr(i, 1) = Application.Round(qarr(i, 1) / b, 2)
            s = s + qarr(i, 1)
        Next i
    On Error GoTo 0
.Range("K1") = "ВСЕГО КП на сумму: " & Format(s, "Standard") & " " & " евро."
    With .Range("K1")
        .Font.Color = -3407872
        .Font.Bold = True
    End With
End With
End Sub
[/vba]
работает не совсем корректно. При фильтрации по нескольким диапазонам, он сохраняет данные только первого отфильтрованного блока, игнорируя остальные.
Подскажите, где подправить нужно?
И ещё вопрос: можно ли как-то сделать, чтобы макрос запускался автоматически при фильтрации?
Пример прилагаю.
К сообщению приложен файл: 7978952.xlsm(22.8 Kb)


Сообщение отредактировал Xpert - Пятница, 16.07.2021, 19:16
 
Ответить
СообщениеВсех приветствую!
Помогите, пожалуйста, с написанием макроса, который загонял бы в массив только отфильтрованные(видимые) значения.
Макрос:
[vba]
Код

Sub FltR()
Dim qarr, lrw&, i&, b#, s
With Лист1
    s = 0
        lrw = .Range("D" & Rows.Count).End(xlUp).Row
            qarr = .Range("C2:D" & lrw).SpecialCells(xlVisible)
    On Error Resume Next
        For i = LBound(qarr) To UBound(qarr)
         If qarr(i, 2) = "EUR" Then
            b = 1
            Else
            b = .Range("F1").Value
        End If
            qarr(i, 1) = Application.Round(qarr(i, 1) / b, 2)
            s = s + qarr(i, 1)
        Next i
    On Error GoTo 0
.Range("K1") = "ВСЕГО КП на сумму: " & Format(s, "Standard") & " " & " евро."
    With .Range("K1")
        .Font.Color = -3407872
        .Font.Bold = True
    End With
End With
End Sub
[/vba]
работает не совсем корректно. При фильтрации по нескольким диапазонам, он сохраняет данные только первого отфильтрованного блока, игнорируя остальные.
Подскажите, где подправить нужно?
И ещё вопрос: можно ли как-то сделать, чтобы макрос запускался автоматически при фильтрации?
Пример прилагаю.

Автор - Xpert
Дата добавления - 16.07.2021 в 19:13
doober Дата: Пятница, 16.07.2021, 20:30 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 773
Репутация: 289 ±
Замечаний: 0% ±

Excel 2010
Подскажите, где подправить нужно?

Здравствуйте.
Так не работают с видимыми ячейками, их только перебирают
[vba]
Код
Sub FltR()
    Dim qarr, lrw&, i&, b#, b1#, s#, Rng As Range, cel As Range, vl#
    With Лист1
        s = 0
        b1 = .Range("F1").Value
        lrw = .Range("D" & Rows.Count).End(xlUp).Row
        Set Rng = .Range("C2:D" & lrw).SpecialCells(xlVisible)
        For Each cel In Rng.Cells
            Select Case cel.Column
            Case 3
                vl = cel
            Case 4
                b = IIf(cel = "EUR", 1, b1)
                s = s + vl / b
            End Select
        Next
        s = Math.Round(s, 2)
        .Range("K1") = "ВСЕГО КП на сумму: " & Format(s, "Standard") & " " & " евро."
        With .Range("K1")
            .Font.Color = -3407872
            .Font.Bold = True
        End With
    End With
End Sub
[/vba]


 
Ответить
Сообщение
Подскажите, где подправить нужно?

Здравствуйте.
Так не работают с видимыми ячейками, их только перебирают
[vba]
Код
Sub FltR()
    Dim qarr, lrw&, i&, b#, b1#, s#, Rng As Range, cel As Range, vl#
    With Лист1
        s = 0
        b1 = .Range("F1").Value
        lrw = .Range("D" & Rows.Count).End(xlUp).Row
        Set Rng = .Range("C2:D" & lrw).SpecialCells(xlVisible)
        For Each cel In Rng.Cells
            Select Case cel.Column
            Case 3
                vl = cel
            Case 4
                b = IIf(cel = "EUR", 1, b1)
                s = s + vl / b
            End Select
        Next
        s = Math.Round(s, 2)
        .Range("K1") = "ВСЕГО КП на сумму: " & Format(s, "Standard") & " " & " евро."
        With .Range("K1")
            .Font.Color = -3407872
            .Font.Bold = True
        End With
    End With
End Sub
[/vba]

Автор - doober
Дата добавления - 16.07.2021 в 20:30
Xpert Дата: Понедельник, 19.07.2021, 09:27 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 82
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
doober, спасибо!
Подскажите, пожалуйста, что означает IIf в строке
[vba]
Код

Case 4
  b = IIf(cel = "EUR", 1, b1)
[/vba]

И ещё: как сделать, чтобы макрос запускался не с кнопки, а непосредственно при фильтрации?
 
Ответить
Сообщениеdoober, спасибо!
Подскажите, пожалуйста, что означает IIf в строке
[vba]
Код

Case 4
  b = IIf(cel = "EUR", 1, b1)
[/vba]

И ещё: как сделать, чтобы макрос запускался не с кнопки, а непосредственно при фильтрации?

Автор - Xpert
Дата добавления - 19.07.2021 в 09:27
doober Дата: Понедельник, 19.07.2021, 12:54 | Сообщение № 4
Группа: Друзья
Ранг: Ветеран
Сообщений: 773
Репутация: 289 ±
Замечаний: 0% ±

Excel 2010
И ещё: как сделать, чтобы макрос запускался не с кнопки, а непосредственно при фильтрации?
Никак, нет события на которое можно повесть макрос
[vba]
Код
    b = IIf(cel = "EUR", 1, b1) Это краткая записи условия, которое ниже
    If cel = "EUR" Then
        b = 1
    Else
        b = b1
    End If
[/vba]


 
Ответить
Сообщение
И ещё: как сделать, чтобы макрос запускался не с кнопки, а непосредственно при фильтрации?
Никак, нет события на которое можно повесть макрос
[vba]
Код
    b = IIf(cel = "EUR", 1, b1) Это краткая записи условия, которое ниже
    If cel = "EUR" Then
        b = 1
    Else
        b = b1
    End If
[/vba]

Автор - doober
Дата добавления - 19.07.2021 в 12:54
RAN Дата: Понедельник, 19.07.2021, 13:25 | Сообщение № 5
Группа: Друзья
Ранг: Участник клуба
Сообщений: 5443
Репутация: 1096 ±
Замечаний: 0% ±

2010
А так? :p
К сообщению приложен файл: 5498486.jpg(17.4 Kb)


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеА так? :p

Автор - RAN
Дата добавления - 19.07.2021 в 13:25
doober Дата: Понедельник, 19.07.2021, 14:06 | Сообщение № 6
Группа: Друзья
Ранг: Ветеран
Сообщений: 773
Репутация: 289 ±
Замечаний: 0% ±

Excel 2010
Я не сторонник дергать этот макрос не по кнопке.
Например, будет 100к строк.


 
Ответить
СообщениеЯ не сторонник дергать этот макрос не по кнопке.
Например, будет 100к строк.

Автор - doober
Дата добавления - 19.07.2021 в 14:06
Xpert Дата: Понедельник, 19.07.2021, 14:19 | Сообщение № 7
Группа: Пользователи
Ранг: Участник
Сообщений: 82
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
А так?

При попытке использовать метод, предложенный RAN, возникает ошибка.

А при попытке закрыть документ - программа зависает.
К сообщению приложен файл: 1034629.png(48.9 Kb)
 
Ответить
Сообщение
А так?

При попытке использовать метод, предложенный RAN, возникает ошибка.

А при попытке закрыть документ - программа зависает.

Автор - Xpert
Дата добавления - 19.07.2021 в 14:19
Serge_007 Дата: Понедельник, 19.07.2021, 14:34 | Сообщение № 8
Группа: Админы
Ранг: Местный житель
Сообщений: 14333
Репутация: 2368 ±
Замечаний: ±

Excel 2010
При попытке использовать метод, предложенный RAN
Андрей не предлагал никаких методов
Суть поста Андрея сводится к тому, что применяя на листе любую волатильную функцию, использовать возникающее при использовании фильтра событие пересчета листа

возникает ошибка
Ошибки при этом быть не может


Яндекс-деньги:41001419691823 | WMR:126292472390
 
Ответить
Сообщение
При попытке использовать метод, предложенный RAN
Андрей не предлагал никаких методов
Суть поста Андрея сводится к тому, что применяя на листе любую волатильную функцию, использовать возникающее при использовании фильтра событие пересчета листа

возникает ошибка
Ошибки при этом быть не может

Автор - Serge_007
Дата добавления - 19.07.2021 в 14:34
Xpert Дата: Понедельник, 19.07.2021, 14:59 | Сообщение № 9
Группа: Пользователи
Ранг: Участник
Сообщений: 82
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Суть поста Андрея сводится к тому, что применяя на листе любую волатильную функцию, использовать возникающее при использовании фильтра событие пересчета листа

Serge_007, именно это я и назвал "методом". Завёл на лист функцию СЕГОДНЯ, и прикрутил макрос doober'а к событию Calculate.
При использовании фильтра возникает ошибка
К сообщению приложен файл: 1169109.png(48.9 Kb)
 
Ответить
Сообщение
Суть поста Андрея сводится к тому, что применяя на листе любую волатильную функцию, использовать возникающее при использовании фильтра событие пересчета листа

Serge_007, именно это я и назвал "методом". Завёл на лист функцию СЕГОДНЯ, и прикрутил макрос doober'а к событию Calculate.
При использовании фильтра возникает ошибка

Автор - Xpert
Дата добавления - 19.07.2021 в 14:59
Serge_007 Дата: Понедельник, 19.07.2021, 15:41 | Сообщение № 10
Группа: Админы
Ранг: Местный житель
Сообщений: 14333
Репутация: 2368 ±
Замечаний: ±

Excel 2010
это я и назвал "методом"
Определение "метод" существует в VBA, но это совсем не то, что Вы назвали "методом", поэтому Вы сбили меня с толку)

При использовании фильтра возникает ошибка
Эта ошибка не связана, выражаясь по-Вашему, с "методом" Андрея, ошибка в исходном макросе, вернее в форме его применения


Яндекс-деньги:41001419691823 | WMR:126292472390
 
Ответить
Сообщение
это я и назвал "методом"
Определение "метод" существует в VBA, но это совсем не то, что Вы назвали "методом", поэтому Вы сбили меня с толку)

При использовании фильтра возникает ошибка
Эта ошибка не связана, выражаясь по-Вашему, с "методом" Андрея, ошибка в исходном макросе, вернее в форме его применения

Автор - Serge_007
Дата добавления - 19.07.2021 в 15:41
doober Дата: Вторник, 20.07.2021, 12:47 | Сообщение № 11
Группа: Друзья
Ранг: Ветеран
Сообщений: 773
Репутация: 289 ±
Замечаний: 0% ±

Excel 2010
вернее в форме его применения

Котяра мяукнул картинкой и ввел в заблуждение ТС.
Так применять надо[vba]
Код
Private Sub Worksheet_Calculate()
    Application.Calculation = xlCalculationManual
    FltR
    Application.Calculation = xlCalculationAutomatic
End Sub
[/vba]


 
Ответить
Сообщение
вернее в форме его применения

Котяра мяукнул картинкой и ввел в заблуждение ТС.
Так применять надо[vba]
Код
Private Sub Worksheet_Calculate()
    Application.Calculation = xlCalculationManual
    FltR
    Application.Calculation = xlCalculationAutomatic
End Sub
[/vba]

Автор - doober
Дата добавления - 20.07.2021 в 12:47
Xpert Дата: Вторник, 20.07.2021, 14:47 | Сообщение № 12
Группа: Пользователи
Ранг: Участник
Сообщений: 82
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
doober, к сожалению, при таком способе также выскакивает ошибка(ссылается ошибку метода Special Cells объекта Range), далее файл зависает, и выйти из него можно только через диспетчер задач...
К сообщению приложен файл: 8057806.png(127.0 Kb)


Сообщение отредактировал Xpert - Вторник, 20.07.2021, 14:47
 
Ответить
Сообщениеdoober, к сожалению, при таком способе также выскакивает ошибка(ссылается ошибку метода Special Cells объекта Range), далее файл зависает, и выйти из него можно только через диспетчер задач...

Автор - Xpert
Дата добавления - 20.07.2021 в 14:47
doober Дата: Вторник, 20.07.2021, 17:23 | Сообщение № 13
Группа: Друзья
Ранг: Ветеран
Сообщений: 773
Репутация: 289 ±
Замечаний: 0% ±

Excel 2010
так надо[vba]
Код
Private Sub Worksheet_Calculate()
    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        FltR
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With

End Sub
[/vba]


 
Ответить
Сообщениетак надо[vba]
Код
Private Sub Worksheet_Calculate()
    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        FltR
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With

End Sub
[/vba]

Автор - doober
Дата добавления - 20.07.2021 в 17:23
Xpert Дата: Среда, 21.07.2021, 08:26 | Сообщение № 14
Группа: Пользователи
Ранг: Участник
Сообщений: 82
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Спасибо большое всем, особенно doober.

Вопрос решён.
 
Ответить
СообщениеСпасибо большое всем, особенно doober.

Вопрос решён.

Автор - Xpert
Дата добавления - 21.07.2021 в 08:26
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Записать в массив только отфильтрованные ячейки (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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