Добрый день уважаемые форумчане!!! Прошу прощение за беспокойства но вынужден вновь и вновь обратиться к вам за помощью ((((( наткнулся на очень интересную тему: My WebPage и очень заинтересовался как бы мне ее применить к моему файлу. Тем самым я смогу уже скрыть те листы которые создавал для редактирования (если вдруг нужно будет что то добавить), а так я их скрою чтоб оператору не приходилось в них залезать чтоб что то вносить. Первый макрос установил все поправил как нужно и ВУАЛЯ сработал. Ну думал по аналогии сработаю также и на другие выпадающие списки на листе "Журнала прихода" ((((( но тут меня ждало разочарование КОД РУГАЕТСЯ ((((( [img][/img] Мое мнение что скорее всего макросы хоть имеют разные выпадающие списки но наименование самого макроса одинаково ((( [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
[/vba]
Добрый день уважаемые форумчане!!! Прошу прощение за беспокойства но вынужден вновь и вновь обратиться к вам за помощью ((((( наткнулся на очень интересную тему: My WebPage и очень заинтересовался как бы мне ее применить к моему файлу. Тем самым я смогу уже скрыть те листы которые создавал для редактирования (если вдруг нужно будет что то добавить), а так я их скрою чтоб оператору не приходилось в них залезать чтоб что то вносить. Первый макрос установил все поправил как нужно и ВУАЛЯ сработал. Ну думал по аналогии сработаю также и на другие выпадающие списки на листе "Журнала прихода" ((((( но тут меня ждало разочарование КОД РУГАЕТСЯ ((((( [img][/img] Мое мнение что скорее всего макросы хоть имеют разные выпадающие списки но наименование самого макроса одинаково ((( [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
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]
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 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
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
Нажмите debug и увидите, что макрос ругается на код в листе Поставщик, а именно, на Sheets("Поставщик-Грузоперевозчик"). У Вас нет такого листа в книге. На листе Поставщик вообще не нужен этот код, Вы же сортируете уже все на листе журнал прихода
lebensvoll, смотрите еще раз мой пост. В первом блоке сортируем лист Грузоперевозчик, во втором - Поставщик.
Нажмите debug и увидите, что макрос ругается на код в листе Поставщик, а именно, на Sheets("Поставщик-Грузоперевозчик"). У Вас нет такого листа в книге. На листе Поставщик вообще не нужен этот код, Вы же сортируете уже все на листе журнал приходаManyasha
Manyasha, честно признаюсь (((( я так и не понял.... И кстати произвел я эти действия
Цитата
Нажмите debug и увидите, что макрос ругается на код в листе Поставщик
и ну ни как не нашел в коде листа
Цитата
а именно, на Sheets("Поставщик-Грузоперевозчик").
Согласен с вами полностью его нет у меня (он был когда то и я малость произвел правку).
Цитата
На листе Поставщик вообще не нужен этот код, Вы же сортируете уже все на листе журнал прихода
Т.е. получается сортировка производится при внесение нового ПОСТАВЩИКА и ГРУЗОПОЛУЧАТЕЛЯ не на их листах а на листе ЖУРНАЛ ПРИХОДА, так что ли!?. Вот смотрите еще раз файл пожалуйста.
Manyasha, честно признаюсь (((( я так и не понял.... И кстати произвел я эти действия
Цитата
Нажмите debug и увидите, что макрос ругается на код в листе Поставщик
и ну ни как не нашел в коде листа
Цитата
а именно, на Sheets("Поставщик-Грузоперевозчик").
Согласен с вами полностью его нет у меня (он был когда то и я малость произвел правку).
Цитата
На листе Поставщик вообще не нужен этот код, Вы же сортируете уже все на листе журнал прихода
Т.е. получается сортировка производится при внесение нового ПОСТАВЩИКА и ГРУЗОПОЛУЧАТЕЛЯ не на их листах а на листе ЖУРНАЛ ПРИХОДА, так что ли!?. Вот смотрите еще раз файл пожалуйста.lebensvoll
lebensvoll, код на листе Поставщик Вам не нужен! К тому же он не будет работать. Единственное, что Вы можете написать для листа Поставщик, это сортировку столбца со списком при внесении нового элемента, это на случай, если кто-то будет пополнять список не с листа Журнал прихода, а прямо в листе Поставщик.
С листом Грузоперевозчик аналогичная ситуация (кода у Вас там сейчас нет). Единственное, что может понадобиться - это сортировка списка.
На листе журнал прихода, при изменении колонки B выполняется первый блок макроса. Если внесенного значения нет в списке поставщиков, лист Поставщик сортируется. Аналогично с колонкой Х и листом Грузоперевозчик.
lebensvoll, код на листе Поставщик Вам не нужен! К тому же он не будет работать. Единственное, что Вы можете написать для листа Поставщик, это сортировку столбца со списком при внесении нового элемента, это на случай, если кто-то будет пополнять список не с листа Журнал прихода, а прямо в листе Поставщик.
С листом Грузоперевозчик аналогичная ситуация (кода у Вас там сейчас нет). Единственное, что может понадобиться - это сортировка списка.
На листе журнал прихода, при изменении колонки B выполняется первый блок макроса. Если внесенного значения нет в списке поставщиков, лист Поставщик сортируется. Аналогично с колонкой Х и листом Грузоперевозчик.Manyasha