Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1 2 След.
RSS
Сохранять выбранные данные из выпадающих списков на отдельные листы.
 
Здравствуйте.
Пробовал найти здесь похожую информацию, но отчаялся.
Вот задача.
Необходимо создать макрос на кнопку, которая (после ее нажатия) будет сохранять выбранные данные из выпадающих списков (которые выберет пользователь) на отдельные листы.
В одном листе будет сохранять каждое выбранное значение как цифровое увеличение на единицу в соответствующие колонки (Список учета 1 и 2).
А во втором - в конкретные ячейки наименование выбора из выпадающего списка (Лист учета)

Пример файла прилагаю.
Изменено: Semenov_0 - 11 Мар 2018 23:17:10
 
Не очень творческий макрос :)
Код
Sub СОХРАНИТЬ()
Dim aa1%, aa2%, aa3%, aa4%, aa5%
With Sheets(1)
  aa1 = .[B2].Value: aa2 = .[A5].Value: aa3 = .[B5].Value: aa4 = .[C5].Value: aa5 = .[D5].Value
End With
With Sheets(2)
  .Range("A" & aa1 + 1).Offset(0, 1).Value = aa2
  .Range("A" & aa1 + 1).Offset(0, 2).Value = aa3
  .Range("A" & aa1 + 1).Offset(0, 3).Value = aa4
  .Range("A" & aa1 + 1).Offset(0, 4).Value = aa5
End With
With Sheets(3)
  .Range("B" & aa2 + 1).Value = .Range("B" & aa2 + 1).Value + 1
  .Range("B" & aa3 + 18).Value = .Range("B" & aa3 + 18).Value + 1
  .Range("B" & aa4 + 27).Value = .Range("B" & aa4 + 27).Value + 1
End With
Sheets(4).Range("B" & aa5 + 1).Value = Sheets(4).Range("B" & aa5 + 1).Value + 1
End Sub
 
Отлично и кратенько. Но немного не то..В последнем листе должны сохраняться как цифры так и названия выбранных наименований..
А не цифровая позиция наименования выпадающего списка.
 
Semenov_0, задание не понятно. Например почему на листе "СПИСОК учета 1", под 39 пунктов 15? Ведь на листе "Таблица выбора" под пунктом 39 выбрано число "3". Какая взаимосвязь между 3 и 15?
 
В листе "Таблица выбора" работают выпадающие списки. Под номером 39 как раз подхватывается информация (в данном случае это цифра 3) из листа "Список учета 1". Задача состоит в следующем:
1. Пользователь в листе "Таблица выбора" из выпадающих списков делает выбор. Нажимает кнопку "Сохранить".
2. Выбранные данные (как цифры так и текст) должны сохраниться в листах:
2.1. "Список учета 1" и "Список учета 2" нарастающим итогом с шагом +1 в числовом выражении напротив значения, которое будет выбрано в "Таблице выбора".
2.2. "Лист учета" - сохраняется как бы "маска" выбора из листа "Таблица выбора".

Прописанный здесь макрос работает, но не до конца правильно, т.к. надо сохранять не числовой вариант выбора из выпадающего списка, а текст.
То есть, если я выбрал под номером 41 слово "нет", то в "Листе учета" под номером 41 должно отобразиться именно слово "нет", а не цифра 3, которая соответствует его номеру по списку выбора.
Вот как-то так...
 
Макрос работает хорошо для сохранения данных в листах "Список учета1" и "Список учета2".
А вот в "Листе учета" он сохраняет не так как надо..
И лучше, если бы это оформить именно макросом на кнопку "Сохранить", а не прописывать формулу, чтобы подхватывала данные или что-то в этом роде..
 
Смотрите файл. Я дал имена выпадающим спискам через поле "Имя" (это слева от строки формул).
Изменено: Karataev - 28 Мар 2018 21:42:33
 
Да, все работает. Спасибо. Буду дальше наверное уже сам ее расширять для новых списков.
Еще только учусь писать в vba...
 
Что-то ничего не понял..
Так как мне надо больше данных, то я решил добавить выпадающие списки.
Но как только я это сделал, мне выдало ошибку...
Код
Set objControl = shTablica.Shapes("Drop Down 1").ControlFormat 
-- пишет, что не найден.. Не могу понять..((Может подскажете?

вот весь код.я правильно оформил тэгом??
Код
Option Explicit

Sub СОХРАНИТЬ()
    Dim shTablica As Worksheet
    Dim shListUcheta As Worksheet, shSpisok1 As Worksheet, shSpisok2 As Worksheet
    Dim objControl As ControlFormat, rng As Range, var, r As Long
    
    Set shTablica = ActiveSheet
    Set shListUcheta = Worksheets("Лист учета")
    Set shSpisok1 = Worksheets("СПИСОК учета 1")
    Set shSpisok2 = Worksheets("СПИСОК учета 2")
    
    Set objControl = shTablica.Shapes("Drop Down 1").ControlFormat
    r = WorksheetFunction.Match(CDbl(objControl.List(objControl.ListIndex)), shListUcheta.Columns("A"), 0)
    Set objControl = shTablica.Shapes("Drop Down 39").ControlFormat
    shListUcheta.Cells(r, "B").Value = objControl.List(objControl.ListIndex)
    Set objControl = shTablica.Shapes("Drop Down 40").ControlFormat
    shListUcheta.Cells(r, "C").Value = objControl.List(objControl.ListIndex)
    Set objControl = shTablica.Shapes("Drop Down 41").ControlFormat
    shListUcheta.Cells(r, "D").Value = objControl.List(objControl.ListIndex)
    Set objControl = shTablica.Shapes("Drop Down 42").ControlFormat
    shListUcheta.Cells(r, "E").Value = objControl.List(objControl.ListIndex)
    Set objControl = shTablica.Shapes("Drop Down 43").ControlFormat
    shListUcheta.Cells(r, "F").Value = objControl.List(objControl.ListIndex)
    
    Set rng = shSpisok1.Range("A2:B16")
    Set objControl = shTablica.Shapes("Drop Down 39").ControlFormat
    var = objControl.List(objControl.ListIndex)
    r = WorksheetFunction.Match(CDbl(var), rng.Columns("A"), 0)
    rng.Cells(r, "B").Value = rng.Cells(r, "B").Value + 1
    
    Set rng = shSpisok1.Range("A19:B20")
    Set objControl = shTablica.Shapes("Drop Down 40").ControlFormat
    var = objControl.List(objControl.ListIndex)
    r = WorksheetFunction.Match(CDbl(var), rng.Columns("A"), 0)
    rng.Cells(r, "B").Value = rng.Cells(r, "B").Value + 1
    
    Set rng = shSpisok1.Range("A28:B30")
    Set objControl = shTablica.Shapes("Drop Down 41").ControlFormat
    var = objControl.List(objControl.ListIndex)
    r = WorksheetFunction.Match(var, rng.Columns("A"), 0)
    rng.Cells(r, "B").Value = rng.Cells(r, "B").Value + 1
    
    Set rng = shSpisok1.Range("C2:D4")
    Set objControl = shTablica.Shapes("Drop Down 43").ControlFormat
    var = objControl.List(objControl.ListIndex)
    r = WorksheetFunction.Match(CDbl(var), rng.Columns("C"), 0)
    rng.Cells(r, "D").Value = rng.Cells(r, "D").Value + 1

    Set rng = shSpisok2.Range("A2:B211")
    Set objControl = shTablica.Shapes("Drop Down 42").ControlFormat
    var = objControl.List(objControl.ListIndex)
    r = WorksheetFunction.Match(CDbl(var), rng.Columns("A"), 0)
    rng.Cells(r, "B").Value = rng.Cells(r, "B").Value + 1
    
End Sub
Изменено: Semenov_0 - 24 Апр 2018 22:01:58
 
Semenov_0, оформите код тегами.
У Вас ошибка предполагаю здесь (а не там, где Вы написали в посте 9):
Код
Set objControl = shTablica.Shapes("Drop Down 43").ControlFormat

Это означает, на активном листе нет выпадающего списка с именем "Drop Down 43".
В посте 7 я написал, что изменил имена выпадающих списков. Вам надо изменить имя у выпадающего списка, который Вы вставили.
Изменено: Karataev - 17 Апр 2018 19:23:35
 
Так я ж его создал.. именно этот выпадающий список..
в прикрепленном файле он есть..
 
Semenov_0, оформите код в посте 9 тегами.
Надо назначить имя выпадающему списку, об этом написано в посте 7.
 
да-да...я уже увидел, что надо это сделать..
 
ну я наверное совсем никогда ничего не пойму...
имя присвоил.. и все равно - НИЧЕГО...Что я не так делаю?
 
вот и ошибку выдает..
 
Semenov_0, свои сообщения можно редактировать (в том числе и дополнять). А Вы строчите одно сообщение за другим...
 
вот таки вот..
 
Цитата
Юрий М написал:
Semenov_0 , свои сообщения можно редактировать (в том числе и дополнять). А Вы строчите одно сообщение за другим...
ну уж простите, не видел, что можно..
уже вижу.
Изменено: Semenov_0 - 17 Апр 2018 20:57:56
 
Каким же образом тогда изменили стартовое сообщение?
 
стартовое - в смысле самое первое? Если да, то вроде изначально написал все сразу и ничего не менял..
В любом случае, просто значит раньше не обращал внимания на возможность редактирования сообщений..

Да и тут прошу помочь в совсем другом вопросе..
т.к. или лыжи не едут, или...
Изменено: Semenov_0 - 17 Апр 2018 21:21:30
 
А если я не весь код прописал, то будет выдавать ошибку? Я имею в виду, что типа не видит имя списка..

Я имею в виду следующее: прописал только это действие..

Код
Set objControl = shTablica.Shapes("Drop Down 43").ControlFormat
shListUcheta.Cells(r, "G").Value = objControl.List(objControl.ListIndex)

А вот это еще не прописывал...

Код
Set rng = shSpisok1.Range("C2:D4")     
Set objControl = shTablica.Shapes("Drop Down 43").ControlFormat     
var = objControl.List(objControl.ListIndex)     
r = WorksheetFunction.Match(var, rng.Columns("C"), 0)     
rng.Cells(r, "D").Value = rng.Cells(r, "D").Value + 1

ткните мне пальцем кто-нибудь куда и как проставить правильно имя списка, чтобы в коде vba он учитывался и был виден...!!

Изменено: Semenov_0 - 18 Апр 2018 21:48:55
 
Semenov_0, в посте 7 написано, как имя назначать. Прочитайте и сравните с тем, что Вы показываете в посте 17.
Я так понял, что Вы назначили имя ячейке, а нужно назначить имя выпадающему списку - выделите его, а затем в поле "Имя" назначьте имя.
Изменено: Karataev - 24 Апр 2018 22:16:28
 
Цитата
Karataev написал:
Semenov_0, в посте 7 написано, как имя назначать. Прочитайте и сравните с тем, что Вы показываете в посте 17.Я так понял, что Вы назначили имя ячейке, а нужно назначить имя выпадающему списку - выделите его, а затем в поле "Имя" назначьте имя.
!!!Точно!!Нужно на самом деле быть внимательным просто...Нда..
только уже выскочила ошибка cdbl(var)= tipe mismatch вот тут - в строке 4 кода:
Код
 Set rng = shSpisok1.Range("C2:D4")
    Set objControl = shTablica.Shapes("Drop Down 43").ControlFormat
    var = objControl.List(objControl.ListIndex)
    r = WorksheetFunction.Match(CDbl(var), rng.Columns("C"), 0)
    rng.Cells(r, "D").Value = rng.Cells(r, "D").Value + 1
Изменено: Semenov_0 - 26 Апр 2018 22:32:32
 
В переменную "var" данные берутся из выпадающего списка "Drop Down 43".
CDbl переводит данные в переменной "var" в число, но в переменной "var" не число, поэтому происходит ошибка. Значит в выпадающем списке не число.
 
точно. Не число, а текст. Уже начал читать про то, что написано в этой строке..
спасибо за пояснение. Но вот вы прописали такой же код для выпадающего списка 41 - и все работает..
Вот я и подумал, что не стоит переписывать по-другому..
вот как  то выглядит::
Код
Set rng = shSpisok1.Range("A28:B30")
    Set objControl = shTablica.Shapes("Drop Down 41").ControlFormat
    var = objControl.List(objControl.ListIndex)
    r = WorksheetFunction.Match(var, rng.Columns("A"), 0)
    rng.Cells(r, "B").Value = rng.Cells(r, "B").Value + 1
Изменено: Semenov_0 - 26 Апр 2018 22:51:03
 
Для Drop Down 41 нет CDbl.
 
!!точно, исправил..
И уже как-то совсем неудобно становится дальше спрашивать..)
Вроде ничего не пропустил. Код точно такой же..Но пишет ошибку, что "Невозможно получить свойство Match класса WorksheetFunction"
...
Изменено: Semenov_0 - 26 Апр 2018 23:16:48
 
Вроде так не ругается, далее не изучал:
Код
r = WorksheetFunction.Match(var, rng.Columns(1), 0)

P.S. чуть глянул - разбирайтесь с адресацией, не туда пишет:
Код
    rng.Cells(r, "D").Value = rng.Cells(r, "D").Value + 1
Изменено: Hugo - 26 Апр 2018 23:34:18
 
Спасибо. Буду разбираться.

Вопрос только в том, почему один и тот же код для одного и того же действия в одном случае работает, а во втором - нет??
Это как?
Изменено: Semenov_0 - 27 Апр 2018 21:28:03
 
В одном случае с CDbl, в друг - нет:
Код
r = WorksheetFunction.Match(var, rng.Columns(1), 0)
r = WorksheetFunction.Match(CDbl(var), rng.Columns("C"), 0)
Страницы: 1 2 След.
Читают тему (гостей: 1)
Наверх