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

Вход

Регистрация

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

 

= Мир MS Excel/Макрос: цикл и выборка по условию. - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос: цикл и выборка по условию. (Макросы/Sub)
Макрос: цикл и выборка по условию.
Chelovekov Дата: Вторник, 29.12.2020, 06:42 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 187
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Здравствуйте Гуры Екселя. Прошу Вас помочь решить следующую проблему.
Алгоритм макроса следующий:
1. В ячейку B3 вставляется число, начиная с 1 и до числа которое прописывается в ячейке D1.
После того как число вставили , в ячейках А6,С6 и Е6 появляется информация.
2. Далее макрос сравнивает ячейку Е6 с условием в ячейке G1, если оно совпадает данные с ячейки
заносятся в таблицу Результат.

После в ячейку B3 заносится следующая цифра и все вышесказанное повторяется, пока не будет
достигнута последняя цифра по условию (Ячейка D1)

Пример предоставляю.
Спасибо.
К сообщению приложен файл: 0855241.xlsx(15.6 Kb)
 
Ответить
СообщениеЗдравствуйте Гуры Екселя. Прошу Вас помочь решить следующую проблему.
Алгоритм макроса следующий:
1. В ячейку B3 вставляется число, начиная с 1 и до числа которое прописывается в ячейке D1.
После того как число вставили , в ячейках А6,С6 и Е6 появляется информация.
2. Далее макрос сравнивает ячейку Е6 с условием в ячейке G1, если оно совпадает данные с ячейки
заносятся в таблицу Результат.

После в ячейку B3 заносится следующая цифра и все вышесказанное повторяется, пока не будет
достигнута последняя цифра по условию (Ячейка D1)

Пример предоставляю.
Спасибо.

Автор - Chelovekov
Дата добавления - 29.12.2020 в 06:42
topgun88 Дата: Вторник, 29.12.2020, 11:43 | Сообщение № 2
Группа: Пользователи
Ранг: Новичок
Сообщений: 22
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
согласно описанию. можно сильно проще
[vba]
Код

Sub chelovekov()
Dim i As Long, arrVR(), rend As Long
Sheets("Результат").Rows("2:" & Rows.Count).ClearContents
For i = Range("B1") To Range("D1")
    Range("B3") = i
    If Range("E6") = [G1] Then
        arrVR = Range("A6:E6")
        With Sheets("Результат")
            rend = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            .Range("A" & rend) = i
            .Range("B" & rend) = arrVR(1, 1)
            .Range("C" & rend) = arrVR(1, 3)
            .Range("D" & rend) = arrVR(1, 5)
        End With
    End If
Next
End Sub
[/vba]
К сообщению приложен файл: 0855241.xlsm(23.4 Kb)


Сообщение отредактировал topgun88 - Вторник, 29.12.2020, 12:59
 
Ответить
Сообщениесогласно описанию. можно сильно проще
[vba]
Код

Sub chelovekov()
Dim i As Long, arrVR(), rend As Long
Sheets("Результат").Rows("2:" & Rows.Count).ClearContents
For i = Range("B1") To Range("D1")
    Range("B3") = i
    If Range("E6") = [G1] Then
        arrVR = Range("A6:E6")
        With Sheets("Результат")
            rend = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            .Range("A" & rend) = i
            .Range("B" & rend) = arrVR(1, 1)
            .Range("C" & rend) = arrVR(1, 3)
            .Range("D" & rend) = arrVR(1, 5)
        End With
    End If
Next
End Sub
[/vba]

Автор - topgun88
Дата добавления - 29.12.2020 в 11:43
Chelovekov Дата: Вторник, 29.12.2020, 13:17 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 187
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Огромное спасибо hands
С наступающим новым годом !!!!
 
Ответить
СообщениеОгромное спасибо hands
С наступающим новым годом !!!!

Автор - Chelovekov
Дата добавления - 29.12.2020 в 13:17
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос: цикл и выборка по условию. (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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