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

Вход

Регистрация

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

 

= Мир MS Excel/Выполнение макросов с учетом порядкового расположения... - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выполнение макросов с учетом порядкового расположения... (Макросы/Sub)
Выполнение макросов с учетом порядкового расположения...
Сергей13 Дата: Пятница, 16.11.2018, 22:40 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 344
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Здравствуйте.
Ребята возможно ли для выполнения макроса использовать в раскрывающимся списке, не наименования "A","B","C", а порядковое расположение наименований в списке, в данном случае "A" это 1 "B" это 2 и т.д. Потому как наименования могут изменяться а порядковое расположение списка нет.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E3")) Is Nothing Then
    Select Case Target
        Case Is = "A": Call Макрос_A
        Case Is = "B": Call Макрос_B
        Case Is = "C": Call Макрос_C
       Case Is = "D": Call Макрос_D
End Select
End If
End Sub
[/vba]


Сообщение отредактировал Сергей13 - Суббота, 17.11.2018, 00:52
 
Ответить
СообщениеЗдравствуйте.
Ребята возможно ли для выполнения макроса использовать в раскрывающимся списке, не наименования "A","B","C", а порядковое расположение наименований в списке, в данном случае "A" это 1 "B" это 2 и т.д. Потому как наименования могут изменяться а порядковое расположение списка нет.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E3")) Is Nothing Then
    Select Case Target
        Case Is = "A": Call Макрос_A
        Case Is = "B": Call Макрос_B
        Case Is = "C": Call Макрос_C
       Case Is = "D": Call Макрос_D
End Select
End If
End Sub
[/vba]

Автор - Сергей13
Дата добавления - 16.11.2018 в 22:40
krosav4ig Дата: Суббота, 17.11.2018, 01:09 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2346
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim s$, x$, v As Variant
    If Not Intersect(Target, Range("E3")) Is Nothing Then
        s = Target.Validation.Formula1
        v = Evaluate(s)
        If Left(s, 1) = "=" Then
            If TypeName(v) = "Range" Then v = v.Formula
            x = Join(Application.Transpose(v), ";")
        Else: x = s
        End If
        Select Case UBound(Split(";" & Mid(x, 1, InStr(1, x, Target) - 1), ";"))
            Case 1: Call Макрос_1
            Case 2: Call Макрос_2
            Case 3: Call Макрос_3
        End Select
        
        'ИЛИ
        'Application.Run "Макрос_" & UBound(Split(";" & Mid(x, 1, InStr(1, x, Target) - 1), ";"))
    End If
End Sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Суббота, 17.11.2018, 03:59
 
Ответить
СообщениеЗдравствуйте.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim s$, x$, v As Variant
    If Not Intersect(Target, Range("E3")) Is Nothing Then
        s = Target.Validation.Formula1
        v = Evaluate(s)
        If Left(s, 1) = "=" Then
            If TypeName(v) = "Range" Then v = v.Formula
            x = Join(Application.Transpose(v), ";")
        Else: x = s
        End If
        Select Case UBound(Split(";" & Mid(x, 1, InStr(1, x, Target) - 1), ";"))
            Case 1: Call Макрос_1
            Case 2: Call Макрос_2
            Case 3: Call Макрос_3
        End Select
        
        'ИЛИ
        'Application.Run "Макрос_" & UBound(Split(";" & Mid(x, 1, InStr(1, x, Target) - 1), ";"))
    End If
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 17.11.2018 в 01:09
Сергей13 Дата: Суббота, 17.11.2018, 02:02 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 344
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
krosav4ig, При выборе любого наименования из списка, макросы почему-то не срабатывают.
К сообщению приложен файл: test.xlsm (16.8 Kb)


Сообщение отредактировал Сергей13 - Суббота, 17.11.2018, 02:18
 
Ответить
Сообщениеkrosav4ig, При выборе любого наименования из списка, макросы почему-то не срабатывают.

Автор - Сергей13
Дата добавления - 17.11.2018 в 02:02
krosav4ig Дата: Суббота, 17.11.2018, 02:34 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 2346
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Сергей13, вы написали
Цитата Сергей13, 16.11.2018 в 22:40, в сообщении № 1 ()
в раскрывающимся списке
, я и написал макрос для раскрывающегося списка, а в вашем файле
Цитата Сергей13, 16.11.2018 в 22:40, в сообщении № 1 ()
списка нет


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеСергей13, вы написали
Цитата Сергей13, 16.11.2018 в 22:40, в сообщении № 1 ()
в раскрывающимся списке
, я и написал макрос для раскрывающегося списка, а в вашем файле
Цитата Сергей13, 16.11.2018 в 22:40, в сообщении № 1 ()
списка нет

Автор - krosav4ig
Дата добавления - 17.11.2018 в 02:34
Сергей13 Дата: Суббота, 17.11.2018, 03:10 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 344
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
krosav4ig, Извиняюсь, не раскрыл тему более точно.
Цитата
Сергей13 «Потому как наименования могут изменяться а порядковое расположение списка нет»

Так как наименования списка могут изменяться пользователем, в диапазоне который привязан к списку, а порядковое расположение списка неизменно, то как привязать выполнение нужного макроса не к наименованию а к порядковому расположению наименований.
 
Ответить
Сообщениеkrosav4ig, Извиняюсь, не раскрыл тему более точно.
Цитата
Сергей13 «Потому как наименования могут изменяться а порядковое расположение списка нет»

Так как наименования списка могут изменяться пользователем, в диапазоне который привязан к списку, а порядковое расположение списка неизменно, то как привязать выполнение нужного макроса не к наименованию а к порядковому расположению наименований.

Автор - Сергей13
Дата добавления - 17.11.2018 в 03:10
krosav4ig Дата: Суббота, 17.11.2018, 03:25 | Сообщение № 6
Группа: Друзья
Ранг: Старожил
Сообщений: 2346
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Цитата Сергей13, 17.11.2018 в 03:10, в сообщении № 5 ()
в диапазоне
где он?
Цитата Сергей13, 17.11.2018 в 03:10, в сообщении № 5 ()
привязан к списку

его я тоже в вашем файле не нашел


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение
Цитата Сергей13, 17.11.2018 в 03:10, в сообщении № 5 ()
в диапазоне
где он?
Цитата Сергей13, 17.11.2018 в 03:10, в сообщении № 5 ()
привязан к списку

его я тоже в вашем файле не нашел

Автор - krosav4ig
Дата добавления - 17.11.2018 в 03:25
Сергей13 Дата: Суббота, 17.11.2018, 03:32 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 344
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
krosav4ig, Я даже и не знаю, что ответить…
Могу только скрином подтвердить, что при отправке файла список был.
К сообщению приложен файл: 3603606.jpg (51.2 Kb)


Сообщение отредактировал Сергей13 - Суббота, 17.11.2018, 03:36
 
Ответить
Сообщениеkrosav4ig, Я даже и не знаю, что ответить…
Могу только скрином подтвердить, что при отправке файла список был.

Автор - Сергей13
Дата добавления - 17.11.2018 в 03:32
Сергей13 Дата: Суббота, 17.11.2018, 03:38 | Сообщение № 8
Группа: Проверенные
Ранг: Обитатель
Сообщений: 344
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
С форума скачал выставленный файл, список тоже есть.
Диапазон списка
Код
=база_данных!$D$4:$D$6
К сообщению приложен файл: 2510311.xlsm (16.8 Kb)


Сообщение отредактировал Сергей13 - Суббота, 17.11.2018, 04:00
 
Ответить
СообщениеС форума скачал выставленный файл, список тоже есть.
Диапазон списка
Код
=база_данных!$D$4:$D$6

Автор - Сергей13
Дата добавления - 17.11.2018 в 03:38
krosav4ig Дата: Суббота, 17.11.2018, 04:00 | Сообщение № 9
Группа: Друзья
Ранг: Старожил
Сообщений: 2346
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Видимо собака зарылась в разнице версий Excel, у меня сейчас под рукой только 2007
именно поэтому тут написано
Цитата
Старайтесь прилагать файлы в версии Excel 2003-го офиса(xls), так как эти файлы могут открыть пользователи с любой версией Excel, в отличие от файлов версий Excel 2007/2010/2013 (xlsх).

При открытии в E3 проверки данных нет, скрин делать лень.
Нашел диапазон на скрытом листе, в 2007 не поддерживаются источники для проверки данных с другого листа напрямую
исправил макрос во 2 посте

второй вариант макроса[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim s$, x$, v As Variant
    If Not Intersect(Target, Range("E3")) Is Nothing Then
        s = Target.Validation.Formula1
        v = Evaluate(s)
        If Left(s, 1) = "=" Then
            If TypeName(v) = "Range" Then v = v.Formula
            x = Join(Application.Transpose(v), ";")
        Else: x = s
        End If
        Application.Run "Лист1.Макрос_" & UBound(Split(";" & Mid(x, 1, InStr(1, x, Target) - 1), ";"))
    End If
End Sub
[/vba]
К сообщению приложен файл: test-1-.xlsm (16.9 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Суббота, 17.11.2018, 04:05
 
Ответить
СообщениеВидимо собака зарылась в разнице версий Excel, у меня сейчас под рукой только 2007
именно поэтому тут написано
Цитата
Старайтесь прилагать файлы в версии Excel 2003-го офиса(xls), так как эти файлы могут открыть пользователи с любой версией Excel, в отличие от файлов версий Excel 2007/2010/2013 (xlsх).

При открытии в E3 проверки данных нет, скрин делать лень.
Нашел диапазон на скрытом листе, в 2007 не поддерживаются источники для проверки данных с другого листа напрямую
исправил макрос во 2 посте

второй вариант макроса[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim s$, x$, v As Variant
    If Not Intersect(Target, Range("E3")) Is Nothing Then
        s = Target.Validation.Formula1
        v = Evaluate(s)
        If Left(s, 1) = "=" Then
            If TypeName(v) = "Range" Then v = v.Formula
            x = Join(Application.Transpose(v), ";")
        Else: x = s
        End If
        Application.Run "Лист1.Макрос_" & UBound(Split(";" & Mid(x, 1, InStr(1, x, Target) - 1), ";"))
    End If
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 17.11.2018 в 04:00
Сергей13 Дата: Суббота, 17.11.2018, 04:25 | Сообщение № 10
Группа: Проверенные
Ранг: Обитатель
Сообщений: 344
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
krosav4ig,
Цитата
«в 2007 не поддерживаются источники для проверки данных с другого листа».

Так-как у меня есть еще различные списки такого рода, то желательно создавать именные диапазоны?

Сейчас работает, один нюанс выползает. Если удалить в списке выбранное наименование командой Delete то выдает ошибку. Возможно ли пустую ячейку списка как-то привязать к Макросу_0?
 
Ответить
Сообщениеkrosav4ig,
Цитата
«в 2007 не поддерживаются источники для проверки данных с другого листа».

Так-как у меня есть еще различные списки такого рода, то желательно создавать именные диапазоны?

Сейчас работает, один нюанс выползает. Если удалить в списке выбранное наименование командой Delete то выдает ошибку. Возможно ли пустую ячейку списка как-то привязать к Макросу_0?

Автор - Сергей13
Дата добавления - 17.11.2018 в 04:25
krosav4ig Дата: Суббота, 17.11.2018, 04:40 | Сообщение № 11
Группа: Друзья
Ранг: Старожил
Сообщений: 2346
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Цитата Сергей13, 17.11.2018 в 04:25, в сообщении № 10 ()
желательно создавать именные диапазоны?
если нужна обратная совместимость, то да
Цитата Сергей13, 17.11.2018 в 04:25, в сообщении № 10 ()
пустую ячейку списка как-то привязать к Макросу_0

после [vba]
Код
If Not Intersect(Target, Range("E3")) Is Nothing Then
[/vba]добавить[vba]
Код
if isempty(target(1, 1)) then call Макрос_0: Exit Sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение
Цитата Сергей13, 17.11.2018 в 04:25, в сообщении № 10 ()
желательно создавать именные диапазоны?
если нужна обратная совместимость, то да
Цитата Сергей13, 17.11.2018 в 04:25, в сообщении № 10 ()
пустую ячейку списка как-то привязать к Макросу_0

после [vba]
Код
If Not Intersect(Target, Range("E3")) Is Nothing Then
[/vba]добавить[vba]
Код
if isempty(target(1, 1)) then call Макрос_0: Exit Sub
[/vba]

Автор - krosav4ig
Дата добавления - 17.11.2018 в 04:40
Сергей13 Дата: Суббота, 17.11.2018, 05:01 | Сообщение № 12
Группа: Проверенные
Ранг: Обитатель
Сообщений: 344
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
krosav4ig, Работает. Большое спасибо!
Скиньте в личку номер яндекс-кошелька, завтра заброшу за помощь.
 
Ответить
Сообщениеkrosav4ig, Работает. Большое спасибо!
Скиньте в личку номер яндекс-кошелька, завтра заброшу за помощь.

Автор - Сергей13
Дата добавления - 17.11.2018 в 05:01
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выполнение макросов с учетом порядкового расположения... (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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