Помогите, пожалуйста, сделать такую штуку. Что-то мне подсказывает, что это можно сделать маркосами, в которых я ваще ноль. В случае, если в ячейке С4 синей таблицы "Склад", то "Вата (нест. 100 г.)" ищется в красной таблице и в D4 отображается поставщик "Вата (нест. 100 г.)" из красной таблицы. Если у "Вата (нест. 100 г.)" в красной таблице несколько поставщиков, то в ячейке D4 синей таблицы появлялся выпадающий выбиратор, который предлагал бы выбрать между всем поставщиками "Вата (нест. 100 г.)" из столбца "поставщики" красной таблицы. Если получится не маркосами, то бы даже был бы рад еще больше.
Помогите, пожалуйста, сделать такую штуку. Что-то мне подсказывает, что это можно сделать маркосами, в которых я ваще ноль. В случае, если в ячейке С4 синей таблицы "Склад", то "Вата (нест. 100 г.)" ищется в красной таблице и в D4 отображается поставщик "Вата (нест. 100 г.)" из красной таблицы. Если у "Вата (нест. 100 г.)" в красной таблице несколько поставщиков, то в ячейке D4 синей таблицы появлялся выпадающий выбиратор, который предлагал бы выбрать между всем поставщиками "Вата (нест. 100 г.)" из столбца "поставщики" красной таблицы. Если получится не маркосами, то бы даже был бы рад еще больше.AVI
А у меня как раз есть подозрения, что это можно формулами, в которых ноль я [vba]
Код
Sub Список()
Dim i As Long, rw As Long, j As Long Dim Arr() As String Dim Col As Collection
With ActiveSheet With .ListObjects("Таблица2").Sort.SortFields .Clear .Add Key:=Range("Таблица2[[#All],[Наименование]]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal End With With .Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With For i = 4 To Cells(Rows.Count, 2).End(xlUp).Row Cells(i, 5).Validation.Delete Err.Clear On Error Resume Next rw = Columns(8).Find(what:=Cells(i, 2).Value).Row If Err.Number = 0 Then If Cells(rw, 8).Value = Cells(rw + 1, 8).Value Then Set Col = New Collection Do Col.Add Cells(rw, 10).Value rw = rw + 1 Loop While Cells(rw, 8).Value = Cells(rw - 1, 8).Value ReDim Arr(1 To Col.Count) j = Col.Count For j = 1 To Col.Count Arr(j) = Col(j) Next j Cells(i, 5).Validation.Add Type:=xlValidateList, Formula1:=Join(Arr, ",") Else: Cells(i, 5).Value = Cells(rw, 10).Value End If End If Next i
End Sub
[/vba]
А у меня как раз есть подозрения, что это можно формулами, в которых ноль я [vba]
Код
Sub Список()
Dim i As Long, rw As Long, j As Long Dim Arr() As String Dim Col As Collection
With ActiveSheet With .ListObjects("Таблица2").Sort.SortFields .Clear .Add Key:=Range("Таблица2[[#All],[Наименование]]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal End With With .Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With For i = 4 To Cells(Rows.Count, 2).End(xlUp).Row Cells(i, 5).Validation.Delete Err.Clear On Error Resume Next rw = Columns(8).Find(what:=Cells(i, 2).Value).Row If Err.Number = 0 Then If Cells(rw, 8).Value = Cells(rw + 1, 8).Value Then Set Col = New Collection Do Col.Add Cells(rw, 10).Value rw = rw + 1 Loop While Cells(rw, 8).Value = Cells(rw - 1, 8).Value ReDim Arr(1 To Col.Count) j = Col.Count For j = 1 To Col.Count Arr(j) = Col(j) Next j Cells(i, 5).Validation.Add Type:=xlValidateList, Formula1:=Join(Arr, ",") Else: Cells(i, 5).Value = Cells(rw, 10).Value End If End If Next i
На хоткеи, например, повесить. Иди кнопку прикрутить. Я э не знаю, как Вам удобнее.
Я хотел бы, что маркос срабатывал при выборе "Склад" в столбце "операции". То есть я ввожу дату, выбираю наименование и выбираю "склад" и в это время макрос ищет поставщиков.
На хоткеи, например, повесить. Иди кнопку прикрутить. Я э не знаю, как Вам удобнее.
Я хотел бы, что маркос срабатывал при выборе "Склад" в столбце "операции". То есть я ввожу дату, выбираю наименование и выбираю "склад" и в это время макрос ищет поставщиков.AVI
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, rw As Long, j As Long Dim Arr() As String Dim col As Collection
If Target.Cells.Count = 1 Then If Target.Column = 3 And Target.Value = "Склад" Then With ActiveSheet With .ListObjects("Таблица2").Sort.SortFields .Clear .Add Key:=Range("Таблица2[[#All],[Наименование]]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal End With With .Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With i = Target.Row Cells(i, 5).Validation.Delete Err.Clear On Error Resume Next rw = Columns(8).Find(what:=Cells(i, 2).Value).Row If Err.Number = 0 Then If Cells(rw, 8).Value = Cells(rw + 1, 8).Value Then Set col = New Collection Do col.Add Cells(rw, 10).Value rw = rw + 1 Loop While Cells(rw, 8).Value = Cells(rw - 1, 8).Value ReDim Arr(1 To col.Count) j = col.Count For j = 1 To col.Count Arr(j) = col(j) Next j Cells(i, 5).Validation.Add Type:=xlValidateList, Formula1:=Join(Arr, ",") Cells(i, 5).Select Else: Cells(i, 5).Value = Cells(rw, 10).Value End If End If End If End If
End Sub
[/vba]
Тогда где-то так [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, rw As Long, j As Long Dim Arr() As String Dim col As Collection
If Target.Cells.Count = 1 Then If Target.Column = 3 And Target.Value = "Склад" Then With ActiveSheet With .ListObjects("Таблица2").Sort.SortFields .Clear .Add Key:=Range("Таблица2[[#All],[Наименование]]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal End With With .Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With i = Target.Row Cells(i, 5).Validation.Delete Err.Clear On Error Resume Next rw = Columns(8).Find(what:=Cells(i, 2).Value).Row If Err.Number = 0 Then If Cells(rw, 8).Value = Cells(rw + 1, 8).Value Then Set col = New Collection Do col.Add Cells(rw, 10).Value rw = rw + 1 Loop While Cells(rw, 8).Value = Cells(rw - 1, 8).Value ReDim Arr(1 To col.Count) j = col.Count For j = 1 To col.Count Arr(j) = col(j) Next j Cells(i, 5).Validation.Add Type:=xlValidateList, Formula1:=Join(Arr, ",") Cells(i, 5).Select Else: Cells(i, 5).Value = Cells(rw, 10).Value End If End If End If End If
StoTisteg, Это здорово!! То что надо, но еще последняя просьба. Можно, что бы, если я ОБРАТНО выбираю "заказ" то содержимое соответствующей ячейки очищалось или, что лучше, заполнялось, например "-------------".
StoTisteg, Это здорово!! То что надо, но еще последняя просьба. Можно, что бы, если я ОБРАТНО выбираю "заказ" то содержимое соответствующей ячейки очищалось или, что лучше, заполнялось, например "-------------".AVI
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, rw As Long, j As Long Dim Arr() As String Dim col As Collection
If Target.Cells.Count = 1 Then If Target.Column = 3 And Target.Value = "Склад" Then With ActiveSheet With .ListObjects("Таблица2").Sort.SortFields .Clear .Add Key:=Range("Таблица2[[#All],[Наименование]]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal End With With .Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With i = Target.Row Cells(i, 5).Validation.Delete Err.Clear On Error Resume Next rw = Columns(8).Find(what:=Cells(i, 2).Value).Row If Err.Number = 0 Then If Cells(rw, 8).Value = Cells(rw + 1, 8).Value Then Set col = New Collection Do col.Add Cells(rw, 10).Value rw = rw + 1 Loop While Cells(rw, 8).Value = Cells(rw - 1, 8).Value ReDim Arr(1 To col.Count) j = col.Count For j = 1 To col.Count Arr(j) = col(j) Next j Cells(i, 5).Validation.Add Type:=xlValidateList, Formula1:=Join(Arr, ",") Cells(i, 5).Select Else: Cells(i, 5).Value = Cells(rw, 10).Value End If End If Else If Target.Column = 3 And Target.Value = "Заказ" Then Cells(i,5).Value="-------------" End If End If
End Sub
[/vba] Внимание, код не проверен! Повторюсь, это очень сырой код, который можно и нужно улучшать.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, rw As Long, j As Long Dim Arr() As String Dim col As Collection
If Target.Cells.Count = 1 Then If Target.Column = 3 And Target.Value = "Склад" Then With ActiveSheet With .ListObjects("Таблица2").Sort.SortFields .Clear .Add Key:=Range("Таблица2[[#All],[Наименование]]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal End With With .Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With i = Target.Row Cells(i, 5).Validation.Delete Err.Clear On Error Resume Next rw = Columns(8).Find(what:=Cells(i, 2).Value).Row If Err.Number = 0 Then If Cells(rw, 8).Value = Cells(rw + 1, 8).Value Then Set col = New Collection Do col.Add Cells(rw, 10).Value rw = rw + 1 Loop While Cells(rw, 8).Value = Cells(rw - 1, 8).Value ReDim Arr(1 To col.Count) j = col.Count For j = 1 To col.Count Arr(j) = col(j) Next j Cells(i, 5).Validation.Add Type:=xlValidateList, Formula1:=Join(Arr, ",") Cells(i, 5).Select Else: Cells(i, 5).Value = Cells(rw, 10).Value End If End If Else If Target.Column = 3 And Target.Value = "Заказ" Then Cells(i,5).Value="-------------" End If End If
End Sub
[/vba] Внимание, код не проверен! Повторюсь, это очень сырой код, который можно и нужно улучшать.StoTisteg
Интуитивно понятный код - это когда интуитивно понятно, что это код.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, rw As Long, j As Long Dim Arr() As String Dim col As Collection
If Target.Cells.Count = 1 Then If Target.Column = 3 And Target.Value = "Склад" Then With ActiveSheet With .ListObjects("Таблица2").Sort.SortFields .Clear .Add Key:=Range("Таблица2[[#All],[Наименование]]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal End With With .Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With i = Target.Row Cells(i, 5).Validation.Delete Err.Clear On Error Resume Next rw = Columns(8).Find(what:=Cells(i, 2).Value).Row If Err.Number = 0 Then If Cells(rw, 8).Value = Cells(rw + 1, 8).Value Then Set col = New Collection Do col.Add Cells(rw, 10).Value rw = rw + 1 Loop While Cells(rw, 8).Value = Cells(rw - 1, 8).Value ReDim Arr(1 To col.Count) j = col.Count For j = 1 To col.Count Arr(j) = col(j) Next j Cells(i, 5).Validation.Add Type:=xlValidateList, Formula1:=Join(Arr, ",") Cells(i, 5).Select Else: Cells(i, 5).Value = Cells(rw, 10).Value End If End If Else If Target.Column = 3 And Target.Value = "Заказ" Then Cells(i,5).Value="-------------" End If End If End If
End Sub
[/vba]
Давайте так попробуем:[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, rw As Long, j As Long Dim Arr() As String Dim col As Collection
If Target.Cells.Count = 1 Then If Target.Column = 3 And Target.Value = "Склад" Then With ActiveSheet With .ListObjects("Таблица2").Sort.SortFields .Clear .Add Key:=Range("Таблица2[[#All],[Наименование]]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal End With With .Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With i = Target.Row Cells(i, 5).Validation.Delete Err.Clear On Error Resume Next rw = Columns(8).Find(what:=Cells(i, 2).Value).Row If Err.Number = 0 Then If Cells(rw, 8).Value = Cells(rw + 1, 8).Value Then Set col = New Collection Do col.Add Cells(rw, 10).Value rw = rw + 1 Loop While Cells(rw, 8).Value = Cells(rw - 1, 8).Value ReDim Arr(1 To col.Count) j = col.Count For j = 1 To col.Count Arr(j) = col(j) Next j Cells(i, 5).Validation.Add Type:=xlValidateList, Formula1:=Join(Arr, ",") Cells(i, 5).Select Else: Cells(i, 5).Value = Cells(rw, 10).Value End If End If Else If Target.Column = 3 And Target.Value = "Заказ" Then Cells(i,5).Value="-------------" End If End If End If
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
В этаноле, что ли? 
