Макрос: цикл и выборка по условию.

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Макрос: цикл и выборка по условию. (Макросы/Sub)

Chelovekov

Дата: Вторник, 29.12.2020, 06:42 | Сообщение № 1

Группа: Проверенные

Ранг: Обитатель

Сообщений: 315

Репутация: 0 ±

Замечаний: 80% ±

Excel 2016

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

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

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

К сообщению приложен файл: 0855241.xlsx (15.6 Kb)

Ответить

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]