10.07.2020, 13:37 [+3 UTC]
в нашей команде: 4 664 чел. | участники онлайн: 1 (рекорд: 21)

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

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

все разделы

правила

новости

участники

доска почёта

форум

блоги

поиск

статистика

наш журнал

наши встречи

наша галерея

отзывы о нас

поддержка

руководство

Версия системы:
7.89 (25.04.2020)
JS-v.1.45 | CSS-v.3.39

Общие новости:
13.04.2020, 00:02

Форум:
10.07.2020, 10:13

Последний вопрос:
10.07.2020, 12:23
Всего: 152724

Последний ответ:
09.07.2020, 02:47
Всего: 260324

Последняя рассылка:
10.07.2020, 08:15

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

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

Наша кнопка:

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

Отзывы о нас:
31.08.2019, 12:52 »
dar777
Это самое лучшее решение! [вопрос № 196237, ответ № 278621]
30.09.2010, 11:14 »
Евгений/Genia007/
Спасибо. Осталось попробовать пункты 1, 3, 4. [вопрос № 180094, ответ № 263268]

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

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

[администратор рассылки: Megaloman (Мастер-Эксперт)]

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

Зенченко Константин Николаевич
Статус: Старший модератор
Рейтинг: 286
solowey
Статус: Профессионал
Рейтинг: 176
Megaloman
Статус: Мастер-Эксперт
Рейтинг: 62

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

Консультация онлайн # 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.14700 сек.

© 2001-2020, Портал RFPRO.RU, Россия
Калашников О.А.  |  Гладенюк А.Г.
Версия системы: 7.89 от 25.04.2020
Версия JS: 1.45 | Версия CSS: 3.39