18.06.2019, 13:15 [+3 UTC]
в нашей команде: 3 711 чел. | участники онлайн: 13 (рекорд: 21)

:: РЕГИСТРАЦИЯ

задать вопрос

все разделы

правила

новости

участники

доска почёта

форум

блоги

поиск

статистика

наш журнал

наши встречи

наша галерея

отзывы о нас

поддержка

руководство

Версия системы:
7.77 (31.05.2019)
JS-v.1.34 | CSS-v.3.35

Общие новости:
28.04.2019, 09:13

Форум:
18.06.2019, 08:32

Последний вопрос:
17.06.2019, 15:06
Всего: 149828

Последний ответ:
18.06.2019, 12:04
Всего: 258619

Последняя рассылка:
17.06.2019, 20:45

Писем в очереди:
3

Мы в соцсетях:

Наша кнопка:

RFpro.ru - здесь вам помогут!

Отзывы о нас:
12.02.2019, 19:13 »
dar777
Это самое лучшее решение! [вопрос № 194692, ответ № 277457]
20.01.2011, 15:43 »
Алексей Гладенюк
Спасибо, достаточно понятный и развернутый ответ. Успехов! [вопрос № 181940, ответ № 265516]

РАЗДЕЛ • Пакет MSOffice

Установка, настройка и работа в пакете Microsoft Office.

[администратор рассылки: Megaloman (Академик)]

Лучшие эксперты в этом разделе

solowey
Статус: Практикант
Рейтинг: 360
Зенченко Константин Николаевич
Статус: Старший модератор
Рейтинг: 240
Megaloman
Статус: Академик
Рейтинг: 205

Перейти к консультации №:
 

Консультация онлайн # 195740
Раздел: • Пакет MSOffice
Автор вопроса: Sashasss3 (Посетитель)
Отправлена: 28.05.2019, 13:22
Поступило ответов: 2

Всем Здравствуйте! Прошу помощи, необходимо составить программу в VBA Excel c помощью макросов. Задание такое: Составить список товаров, стоимость которых больше заданной. То есть будет таблица с такими столбцами "Название товара" и "Стоимость". По нажатию кнопки нужно чтобы появлялось окно с вводом
цены, и программа на другом листе должна создать такую же таблицу , только с теми товарами с ценовой категорией меньше заданной. Заранее спасибо!

Последнее редактирование 28.05.2019, 14:21 Сергей Фрост (Управляющий)

Состояние: Консультация закрыта

Ответ # 278237 от solowey (Практикант)

Здравствуйте, Sashasss3
Вот пример кода:

Private Sub CommandButton1_Click()
    Dim cell As Range
    Dim value As Double
    numCell = 2
    Set rgData = Range("B2:B11")
    s = Replace(TextBox1.value, ".", ",")
    value = CDbl(s)
    
    Set myList = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    myList.Cells(1, 1) = Sheets("Лист1").Cells(1, 1)
    myList.Cells(1, 2) = Sheets("Лист1").Cells(1, 2)
    
    For Each cell In rgData
        If cell.value > value Then
            myList.Cells(numCell, 1) = Sheets("Лист1").Cells(cell.Row, cell.Column - 1)
            myList.Cells(numCell, 2) = Sheets("Лист1").Cells(cell.Row, cell.Column)
            numCell = numCell + 1
        End If
    Next
    UserForm1.Hide
End Sub

Во вложение пример.


Консультировал: solowey (Практикант)
Дата отправки: 29.05.2019, 10:21

-----
 Прикрепленный файл: скачать (ZIP) » [18.3 кб]

Рейтинг ответа:

0

[подробно]

Сообщение
модераторам

Отправлять сообщения
модераторам могут
только участники портала.
ВОЙТИ НА ПОРТАЛ »
регистрация »

Ответ # 278243 от Megaloman (Академик)

Здравствуйте, Sashasss3!
Мой вариант решения: таблица ya19052920.xlsm (38.8 кб)
Макрос:

Sub RRR()

    Shapka = "B2:C3"        ' Область шапки
    RFil = "C3"             ' Ячейка с фильтром по цене
    RName = "B3"            ' Ячейка с шапкой с названиями (товар обязательно должен иметь название)
    Info = "C1"             ' Ячейка куда запишется значение фильтра в выходной форме
    
    NewList = "Отобрано"    ' Имя листа, если выборка делается на один и тот же лист
    
    R1 = Mid(Shapka, 1, InStr(1, Shapka, CStr(Range(Shapka).Row) + ":") - 1) + "1"
    
    ACol = Replace(Shapka, CStr(Range(Shapka).Row) + ":", ":")
    FRow = Range(Shapka).Cells(Range(Shapka).Count).Row
    ACol = Replace(ACol, CStr(FRow), "")
    
    iFil = 1 + Range(RFil).Column - Range(Shapka).Column ' Номер столбца в шапке для фильтра
    
    iReestr = ActiveSheet.Index
        
    CGod = InputBox("Введите цену товара", "Отбор товара не более указанной цены")
    
    If CGod = "" Then Exit Sub
    If Not IsNumeric(CGod) Then
        MsgBox "Введенное значение цены" + vbCrLf + vbCrLf + """" + CGod + """" + vbCrLf + vbCrLf + "не число"
        Exit Sub
    End If
    
    God = CCur(CGod)
    If God < 0 Then
        MsgBox "Введенное значение цены" + vbCrLf + vbCrLf + """" + CGod + """" + vbCrLf + vbCrLf + "не корректно"
        Exit Sub
    End If
    
    'NewList = CGod              ' Закомментировать, чтобы выборка делалась на один лист
                                ' Иначе выборка для каждой цены будет на отдельном листе со значением цены
    Application.DisplayAlerts = False
    On Error Resume Next
        Sheets(NewList).Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = NewList
    
    iNew = ActiveSheet.Index
    
    Sheets(iReestr).Select
    Columns(ACol).Copy
    
    Sheets(iNew).Select
    Range(R1).Select
    Range(R1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
    Sheets(iReestr).Select
    AFiltr = Replace(ACol, ":", CStr(Range(Shapka).Row + 1) + ":") + CStr(Range(RName).End(xlDown).Row)
    
    ActiveSheet.Range(AFiltr).AutoFilter Field:=iFil, Criteria1:="<=" + Replace(CGod, ",", "."), Operator:=xlAnd

    Columns(ACol).Copy
    Sheets(iNew).Select
    Range(R1).Select
    ActiveSheet.Paste
    Sheets(iReestr).Select
    Selection.AutoFilter
    Range(R1).Select
    Sheets(iNew).Select
    Range(Info) = "<=" + CGod
    Range(Info).Select
    
End Sub


Консультировал: Megaloman (Академик)
Дата отправки: 29.05.2019, 20:13

Рейтинг ответа:

0

[подробно]

Сообщение
модераторам

Отправлять сообщения
модераторам могут
только участники портала.
ВОЙТИ НА ПОРТАЛ »
регистрация »

Мини-форум консультации № 195740

Megaloman
Академик

ID: 137394

# 1

= общий = | 29.05.2019, 20:21 | цитировать цитировать  | профиль профиль  |  отправить письмо в личную почту пейджер
Sashasss3:

Похоже на Когнити́вный диссона́нс

© Цитата: Sashasss3
Составить список товаров, стоимость которых больше заданной.
© Цитата: Sashasss3
программа на другом листе должна создать такую же таблицу , только с теми товарами с ценовой категорией меньше заданной
У меня в коде <=. Уточняйте условие.

=====
Нет времени на медленные танцы

Sashasss3
Посетитель

ID: 403001

# 2

= общий = | 29.05.2019, 22:16 | цитировать цитировать  | профиль профиль  |  отправить письмо в личную почту пейджер
Megaloman:

А где в данном коде поменять на то чтобы он показывал товары не меньшей стоимости , а наоборот больше заданной?

Megaloman
Академик

ID: 137394

# 3

= общий = | 29.05.2019, 23:02 | цитировать цитировать  | профиль профиль  |  отправить письмо в личную почту пейджер
Sashasss3:

не проверял, завтра доберусь до компьютера.
В двух местах поменять "<=" на ">" или, если надо, ">=", в зависимости от того, что реально нужно.
Еще лучше, это условие прописать в начале в строковой переменной, что позволит в одном месте при желании изменять условия отбора и не искать эти условия в коде.

-----
Последнее редактирование 29.05.2019, 23:07 Megaloman (Академик)

=====
Нет времени на медленные танцы

Megaloman
Академик

ID: 137394

# 4

= общий = | 30.05.2019, 09:27 | цитировать цитировать  | профиль профиль  |  отправить письмо в личную почту пейджер
Sashasss3:

Вот вариант таблицы: ya190530.xlsm (39.8 кб) Условие сравнения задаётся среди настроечных параметров. Изменения кода самые минимальные.

-----
Последнее редактирование 30.05.2019, 09:34 Megaloman (Академик)

=====
Нет времени на медленные танцы

 

Возможность оставлять сообщения в мини-форумах консультаций доступна только после входа в систему.
Воспользуйтесь кнопкой входа вверху страницы, если Вы зарегистрированы или пройдите простую процедуру регистрации на Портале.

Яндекс Rambler's Top100

главная страница | поддержка | задать вопрос

Время генерирования страницы: 0.45849 сек.

© 2001-2019, Портал RFPRO.RU, Россия
Калашников О.А.  |  Гладенюк А.Г.
Версия системы: 7.77 от 31.05.2019
Версия JS: 1.34 | Версия CSS: 3.35