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

Вход

Регистрация

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

 

= Мир MS Excel/Код ругается скорее всего из-за дубляжа - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Код ругается скорее всего из-за дубляжа (Макросы/Sub)
Код ругается скорее всего из-за дубляжа
lebensvoll Дата: Вторник, 19.07.2016, 16:00 | Сообщение № 1
Группа: Проверенные
Ранг: Старожил
Сообщений: 1002
Репутация: 30 ±
Замечаний: 0% ±

Excel 2010
Добрый день уважаемые форумчане!!!
Прошу прощение за беспокойства но вынужден вновь и вновь обратиться к вам за помощью ((((( наткнулся на очень интересную тему: My WebPage и очень заинтересовался как бы мне ее применить к моему файлу. Тем самым я смогу уже скрыть те листы которые создавал для редактирования (если вдруг нужно будет что то добавить), а так я их скрою чтоб оператору не приходилось в них залезать чтоб что то вносить.
Первый макрос установил все поправил как нужно и ВУАЛЯ сработал.
Ну думал по аналогии сработаю также и на другие выпадающие списки на листе "Журнала прихода" ((((( но тут меня ждало разочарование КОД РУГАЕТСЯ (((((
[img][/img]
Мое мнение что скорее всего макросы хоть имеют разные выпадающие списки но наименование самого макроса одинаково (((
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
[/vba]
К сообщению приложен файл: _2.xlsm (79.9 Kb)


Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеДобрый день уважаемые форумчане!!!
Прошу прощение за беспокойства но вынужден вновь и вновь обратиться к вам за помощью ((((( наткнулся на очень интересную тему: My WebPage и очень заинтересовался как бы мне ее применить к моему файлу. Тем самым я смогу уже скрыть те листы которые создавал для редактирования (если вдруг нужно будет что то добавить), а так я их скрою чтоб оператору не приходилось в них залезать чтоб что то вносить.
Первый макрос установил все поправил как нужно и ВУАЛЯ сработал.
Ну думал по аналогии сработаю также и на другие выпадающие списки на листе "Журнала прихода" ((((( но тут меня ждало разочарование КОД РУГАЕТСЯ (((((
[img][/img]
Мое мнение что скорее всего макросы хоть имеют разные выпадающие списки но наименование самого макроса одинаково (((
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
[/vba]

Автор - lebensvoll
Дата добавления - 19.07.2016 в 16:00
Manyasha Дата: Вторник, 19.07.2016, 16:12 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
lebensvoll, здравствуйте. Макросов с одинаковым названием не должно быть, объединяйте все в один:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lReply As Long
    If Target.Cells.Count > 1 Then Exit Sub
    
    If Not Intersect(Target, Range("X3:X10000")) Is Nothing Then
        If IsEmpty(Target) Then Exit Sub
            If WorksheetFunction.CountIf(Sheets("Грузоперевозчик").Range("Грузоперевозчик"), Target) = 0 Then
                lReply = MsgBox("Добавить введенное имя " & Target & " в выпадающий список?", vbYesNo + vbQuestion)
                    If lReply = vbYes Then
                        Worksheets("Грузоперевозчик").Range("Грузоперевозчик").Cells(Worksheets("Грузоперевозчик").Range("Грузоперевозчик").Rows.Count + 1, 1) = Target
                        Sheets("Грузоперевозчик").Range("B1:B1000").Sort Key1:=Sheets("Грузоперевозчик").Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
                            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                            DataOption1:=xlSortNormal 'этот код и поможет отсортировать в алфавитном порядке
                    End If
            End If
    End If
    
    If Not Intersect(Target, Range("B3:B10000")) Is Nothing Then
        If IsEmpty(Target) Then Exit Sub
            If WorksheetFunction.CountIf(Sheets("Поставщик").Range("Поставщик"), Target) = 0 Then
                lReply = MsgBox("Добавить введенное имя " & Target & " в выпадающий список?", vbYesNo + vbQuestion)
                    If lReply = vbYes Then
                        Worksheets("Поставщик").Range("Поставщик").Cells(Worksheets("Поставщик").Range("Поставщик").Rows.Count + 1, 1) = Target
                        Sheets("Поставщик").Range("B1:B1000").Sort Key1:=Sheets("Поставщик").Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
                            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                            DataOption1:=xlSortNormal 'этот код и поможет отсортировать в алфавитном порядке
                    End If
            End If
    End If
    
End Sub
[/vba]


ЯД: 410013299366744 WM: R193491431804

Сообщение отредактировал Manyasha - Вторник, 19.07.2016, 16:22
 
Ответить
Сообщениеlebensvoll, здравствуйте. Макросов с одинаковым названием не должно быть, объединяйте все в один:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lReply As Long
    If Target.Cells.Count > 1 Then Exit Sub
    
    If Not Intersect(Target, Range("X3:X10000")) Is Nothing Then
        If IsEmpty(Target) Then Exit Sub
            If WorksheetFunction.CountIf(Sheets("Грузоперевозчик").Range("Грузоперевозчик"), Target) = 0 Then
                lReply = MsgBox("Добавить введенное имя " & Target & " в выпадающий список?", vbYesNo + vbQuestion)
                    If lReply = vbYes Then
                        Worksheets("Грузоперевозчик").Range("Грузоперевозчик").Cells(Worksheets("Грузоперевозчик").Range("Грузоперевозчик").Rows.Count + 1, 1) = Target
                        Sheets("Грузоперевозчик").Range("B1:B1000").Sort Key1:=Sheets("Грузоперевозчик").Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
                            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                            DataOption1:=xlSortNormal 'этот код и поможет отсортировать в алфавитном порядке
                    End If
            End If
    End If
    
    If Not Intersect(Target, Range("B3:B10000")) Is Nothing Then
        If IsEmpty(Target) Then Exit Sub
            If WorksheetFunction.CountIf(Sheets("Поставщик").Range("Поставщик"), Target) = 0 Then
                lReply = MsgBox("Добавить введенное имя " & Target & " в выпадающий список?", vbYesNo + vbQuestion)
                    If lReply = vbYes Then
                        Worksheets("Поставщик").Range("Поставщик").Cells(Worksheets("Поставщик").Range("Поставщик").Rows.Count + 1, 1) = Target
                        Sheets("Поставщик").Range("B1:B1000").Sort Key1:=Sheets("Поставщик").Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
                            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                            DataOption1:=xlSortNormal 'этот код и поможет отсортировать в алфавитном порядке
                    End If
            End If
    End If
    
End Sub
[/vba]

Автор - Manyasha
Дата добавления - 19.07.2016 в 16:12
lebensvoll Дата: Вторник, 19.07.2016, 16:13 | Сообщение № 3
Группа: Проверенные
Ранг: Старожил
Сообщений: 1002
Репутация: 30 ±
Замечаний: 0% ±

Excel 2010
Manyasha добрый день, т.е. я правильно понял почему он на меня так ЗЛИЛСЯ!???


Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеManyasha добрый день, т.е. я правильно понял почему он на меня так ЗЛИЛСЯ!???

Автор - lebensvoll
Дата добавления - 19.07.2016 в 16:13
lebensvoll Дата: Вторник, 19.07.2016, 16:23 | Сообщение № 4
Группа: Проверенные
Ранг: Старожил
Сообщений: 1002
Репутация: 30 ±
Замечаний: 0% ±

Excel 2010
Manyasha, также еще один вопрос???
[vba]
Код
  End If
    Sheets("Грузоперевозчик").Range("B1:B1000").Sort Key1:=Sheets("Грузоперевозчик").Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal 'этот код и поможет отсортировать в алфавитном порядке
End Sub
[/vba]
Мне кажется что сортировка по алфавиту будет проводиться лишь на листе Грузоперевозчик не так ли???
Я могу продолжить также по аналогии???
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lReply As Long
    If Target.Cells.Count > 1 Then Exit Sub
    
    If Not Intersect(Target, Range("X3:X1000")) Is Nothing Then
        If IsEmpty(Target) Then Exit Sub
            If WorksheetFunction.CountIf(Sheets("Грузоперевозчик").Range("Грузоперевозчик"), Target) = 0 Then
                lReply = MsgBox("Добавить введенное имя " & Target & " в выпадающий список?", vbYesNo + vbQuestion)
                    If lReply = vbYes Then
                        Worksheets("Грузоперевозчик").Range("Грузоперевозчик").Cells(Worksheets("Грузоперевозчик").Range("Грузоперевозчик").Rows.Count + 1, 1) = Target
                    End If
            End If
    End If
    If Not Intersect(Target, Range("B3:B1000")) Is Nothing Then
        If IsEmpty(Target) Then Exit Sub
            If WorksheetFunction.CountIf(Sheets("Поставщик").Range("Поставщик"), Target) = 0 Then
                lReply = MsgBox("Добавить введенное имя " & Target & " в выпадающий список?", vbYesNo + vbQuestion)
                    If lReply = vbYes Then
                        Worksheets("Поставщик").Range("Поставщик").Cells(Worksheets("Поставщик").Range("Поставщик").Rows.Count + 1, 1) = Target
                    End If
            End If
    End If
    Sheets("Грузоперевозчик").Range("B1:B1000").Sort Key1:=Sheets("Грузоперевозчик").Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal 'этот код и поможет отсортировать в алфавитном порядке
    End If
    Sheets("Поставщик").Range("B1:B1000").Sort Key1:=Sheets("Поставщик").Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal 'этот код и поможет отсортировать в алфавитном порядке
End Sub
[/vba]


Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеManyasha, также еще один вопрос???
[vba]
Код
  End If
    Sheets("Грузоперевозчик").Range("B1:B1000").Sort Key1:=Sheets("Грузоперевозчик").Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal 'этот код и поможет отсортировать в алфавитном порядке
End Sub
[/vba]
Мне кажется что сортировка по алфавиту будет проводиться лишь на листе Грузоперевозчик не так ли???
Я могу продолжить также по аналогии???
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lReply As Long
    If Target.Cells.Count > 1 Then Exit Sub
    
    If Not Intersect(Target, Range("X3:X1000")) Is Nothing Then
        If IsEmpty(Target) Then Exit Sub
            If WorksheetFunction.CountIf(Sheets("Грузоперевозчик").Range("Грузоперевозчик"), Target) = 0 Then
                lReply = MsgBox("Добавить введенное имя " & Target & " в выпадающий список?", vbYesNo + vbQuestion)
                    If lReply = vbYes Then
                        Worksheets("Грузоперевозчик").Range("Грузоперевозчик").Cells(Worksheets("Грузоперевозчик").Range("Грузоперевозчик").Rows.Count + 1, 1) = Target
                    End If
            End If
    End If
    If Not Intersect(Target, Range("B3:B1000")) Is Nothing Then
        If IsEmpty(Target) Then Exit Sub
            If WorksheetFunction.CountIf(Sheets("Поставщик").Range("Поставщик"), Target) = 0 Then
                lReply = MsgBox("Добавить введенное имя " & Target & " в выпадающий список?", vbYesNo + vbQuestion)
                    If lReply = vbYes Then
                        Worksheets("Поставщик").Range("Поставщик").Cells(Worksheets("Поставщик").Range("Поставщик").Rows.Count + 1, 1) = Target
                    End If
            End If
    End If
    Sheets("Грузоперевозчик").Range("B1:B1000").Sort Key1:=Sheets("Грузоперевозчик").Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal 'этот код и поможет отсортировать в алфавитном порядке
    End If
    Sheets("Поставщик").Range("B1:B1000").Sort Key1:=Sheets("Поставщик").Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal 'этот код и поможет отсортировать в алфавитном порядке
End Sub
[/vba]

Автор - lebensvoll
Дата добавления - 19.07.2016 в 16:23
Manyasha Дата: Вторник, 19.07.2016, 16:27 | Сообщение № 5
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
lebensvoll,
я правильно понял почему он на меня так ЗЛИЛСЯ!???

да, и сортировку можно не делать так часто (обновила код в предыдущем своем посте).


ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеlebensvoll,
я правильно понял почему он на меня так ЗЛИЛСЯ!???

да, и сортировку можно не делать так часто (обновила код в предыдущем своем посте).

Автор - Manyasha
Дата добавления - 19.07.2016 в 16:27
lebensvoll Дата: Вторник, 19.07.2016, 16:42 | Сообщение № 6
Группа: Проверенные
Ранг: Старожил
Сообщений: 1002
Репутация: 30 ±
Замечаний: 0% ±

Excel 2010
Manyasha, а если у меня будет еще несколько листов для сортировки ??? Как мне самому дальше продолжить подобного рода сортировку ???
Да и кстати если я выбираю поставщика (т.е. вношу нового) вот что происходит, но самое что интересное )))) он его вносит.

[img][/img]

А если я вношу нового грузополучателя то он так не ругается (((((
Я просто не могу понять вы там прописали везде ПОСТАВЩИКА а грузополучателя нет ((((

[vba]
Код
If Not Intersect(Target, Range("B3:B10000")) Is Nothing Then
        If IsEmpty(Target) Then Exit Sub
            If WorksheetFunction.CountIf(Sheets("Поставщик").Range("Поставщик"), Target) = 0 Then
                lReply = MsgBox("Добавить введенное имя " & Target & " в выпадающий список?", vbYesNo + vbQuestion)
                    If lReply = vbYes Then
                        Worksheets("Поставщик").Range("Поставщик").Cells(Worksheets("Поставщик").Range("Поставщик").Rows.Count + 1, 1) = Target
                        Sheets("Поставщик").Range("B1:B1000").Sort Key1:=Sheets("Поставщик").Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
                            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                            DataOption1:=xlSortNormal 'этот код и поможет отсортировать в алфавитном порядке
                    End If
            End If
    End If
    
End Sub
[/vba]


Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеManyasha, а если у меня будет еще несколько листов для сортировки ??? Как мне самому дальше продолжить подобного рода сортировку ???
Да и кстати если я выбираю поставщика (т.е. вношу нового) вот что происходит, но самое что интересное )))) он его вносит.

[img][/img]

А если я вношу нового грузополучателя то он так не ругается (((((
Я просто не могу понять вы там прописали везде ПОСТАВЩИКА а грузополучателя нет ((((

[vba]
Код
If Not Intersect(Target, Range("B3:B10000")) Is Nothing Then
        If IsEmpty(Target) Then Exit Sub
            If WorksheetFunction.CountIf(Sheets("Поставщик").Range("Поставщик"), Target) = 0 Then
                lReply = MsgBox("Добавить введенное имя " & Target & " в выпадающий список?", vbYesNo + vbQuestion)
                    If lReply = vbYes Then
                        Worksheets("Поставщик").Range("Поставщик").Cells(Worksheets("Поставщик").Range("Поставщик").Rows.Count + 1, 1) = Target
                        Sheets("Поставщик").Range("B1:B1000").Sort Key1:=Sheets("Поставщик").Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
                            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                            DataOption1:=xlSortNormal 'этот код и поможет отсортировать в алфавитном порядке
                    End If
            End If
    End If
    
End Sub
[/vba]

Автор - lebensvoll
Дата добавления - 19.07.2016 в 16:42
Manyasha Дата: Вторник, 19.07.2016, 16:48 | Сообщение № 7
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
lebensvoll, смотрите еще раз мой пост. В первом блоке сортируем лист Грузоперевозчик, во втором - Поставщик.
вот что происходит

Нажмите debug и увидите, что макрос ругается на код в листе Поставщик, а именно, на Sheets("Поставщик-Грузоперевозчик"). У Вас нет такого листа в книге.
На листе Поставщик вообще не нужен этот код, Вы же сортируете уже все на листе журнал прихода


ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеlebensvoll, смотрите еще раз мой пост. В первом блоке сортируем лист Грузоперевозчик, во втором - Поставщик.
вот что происходит

Нажмите debug и увидите, что макрос ругается на код в листе Поставщик, а именно, на Sheets("Поставщик-Грузоперевозчик"). У Вас нет такого листа в книге.
На листе Поставщик вообще не нужен этот код, Вы же сортируете уже все на листе журнал прихода

Автор - Manyasha
Дата добавления - 19.07.2016 в 16:48
lebensvoll Дата: Вторник, 19.07.2016, 17:01 | Сообщение № 8
Группа: Проверенные
Ранг: Старожил
Сообщений: 1002
Репутация: 30 ±
Замечаний: 0% ±

Excel 2010
Manyasha, честно признаюсь (((( я так и не понял....
И кстати произвел я эти действия
Цитата
Нажмите debug и увидите, что макрос ругается на код в листе Поставщик
и ну ни как не нашел в коде листа
Цитата
а именно, на Sheets("Поставщик-Грузоперевозчик").
Согласен с вами полностью его нет у меня (он был когда то и я малость произвел правку).
Цитата
На листе Поставщик вообще не нужен этот код, Вы же сортируете уже все на листе журнал прихода

Т.е. получается сортировка производится при внесение нового ПОСТАВЩИКА и ГРУЗОПОЛУЧАТЕЛЯ не на их листах а на листе ЖУРНАЛ ПРИХОДА, так что ли!?.
Вот смотрите еще раз файл пожалуйста.
К сообщению приложен файл: 6913966.xlsm (90.8 Kb)


Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеManyasha, честно признаюсь (((( я так и не понял....
И кстати произвел я эти действия
Цитата
Нажмите debug и увидите, что макрос ругается на код в листе Поставщик
и ну ни как не нашел в коде листа
Цитата
а именно, на Sheets("Поставщик-Грузоперевозчик").
Согласен с вами полностью его нет у меня (он был когда то и я малость произвел правку).
Цитата
На листе Поставщик вообще не нужен этот код, Вы же сортируете уже все на листе журнал прихода

Т.е. получается сортировка производится при внесение нового ПОСТАВЩИКА и ГРУЗОПОЛУЧАТЕЛЯ не на их листах а на листе ЖУРНАЛ ПРИХОДА, так что ли!?.
Вот смотрите еще раз файл пожалуйста.

Автор - lebensvoll
Дата добавления - 19.07.2016 в 17:01
Manyasha Дата: Вторник, 19.07.2016, 17:21 | Сообщение № 9
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
lebensvoll, код на листе Поставщик Вам не нужен! К тому же он не будет работать. Единственное, что Вы можете написать для листа Поставщик, это сортировку столбца со списком при внесении нового элемента, это на случай, если кто-то будет пополнять список не с листа Журнал прихода, а прямо в листе Поставщик.

С листом Грузоперевозчик аналогичная ситуация (кода у Вас там сейчас нет). Единственное, что может понадобиться - это сортировка списка.

На листе журнал прихода, при изменении колонки B выполняется первый блок макроса. Если внесенного значения нет в списке поставщиков, лист Поставщик сортируется. Аналогично с колонкой Х и листом Грузоперевозчик.
К сообщению приложен файл: 6913966-1.xlsm (87.1 Kb)


ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеlebensvoll, код на листе Поставщик Вам не нужен! К тому же он не будет работать. Единственное, что Вы можете написать для листа Поставщик, это сортировку столбца со списком при внесении нового элемента, это на случай, если кто-то будет пополнять список не с листа Журнал прихода, а прямо в листе Поставщик.

С листом Грузоперевозчик аналогичная ситуация (кода у Вас там сейчас нет). Единственное, что может понадобиться - это сортировка списка.

На листе журнал прихода, при изменении колонки B выполняется первый блок макроса. Если внесенного значения нет в списке поставщиков, лист Поставщик сортируется. Аналогично с колонкой Х и листом Грузоперевозчик.

Автор - Manyasha
Дата добавления - 19.07.2016 в 17:21
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Код ругается скорее всего из-за дубляжа (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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