поиском искал. но даже не пойму как вопрос задать в обшем задача такая в столбец Размер подставить в скобки, через запятую все числа из стобца - Наименование артикула. Но привязка должна быть к стобцу - Наименование. То есть, следующее - Наименование - будет отличаться стобец - Размер, так как в первом случает - Наименование артикула - 6 позиций, во втором 4. а вообще таких строк в базе несколько тысяч спасибо
поиском искал. но даже не пойму как вопрос задать в обшем задача такая в столбец Размер подставить в скобки, через запятую все числа из стобца - Наименование артикула. Но привязка должна быть к стобцу - Наименование. То есть, следующее - Наименование - будет отличаться стобец - Размер, так как в первом случает - Наименование артикула - 6 позиций, во втором 4. а вообще таких строк в базе несколько тысяч спасибоsanders
Function VLOOKUPCOUPLE(Table As Variant, _ SearchColumnNum As Integer, _ SearchValue As Variant, _ RezultColumnNum As Integer, _ Separator_ As String, _ Optional BezPovtorov As Boolean = True)
'Table - таблица, где ищем 'SearchColumnNum - столбец, где ищем 'SearchValue - данные, которые ищем 'RezultColumnNum - колонка, откуда берём результат 'Separator_ - разделитель, желательно вводить с пробелом в конце 'BezPovtorov - если поставить 0, то будут выведены все повторяющиеся совпадения
Dim i As Long, tmp As String, vlk
If TypeName(Table) = "Range" Then Table = Intersect(Table.Parent.UsedRange, Table).Value If BezPovtorov Then With CreateObject("Scripting.Dictionary") For i = 1 To UBound(Table) If Table(i, SearchColumnNum) = SearchValue Then tmp = Table(i, RezultColumnNum) If tmp <> "" Then If Not .Exists(tmp) Then .Add tmp, 0& vlk = vlk & Separator_ & Table(i, RezultColumnNum) End If End If End If Next i End With Else For i = 1 To UBound(Table) If Table(i, SearchColumnNum) = SearchValue Then vlk = vlk & Separator_ & Table(i, RezultColumnNum) End If Next i End If If vlk > 0 Then vlk = Mid(vlk, Len(Separator_) + 1) Else vlk = "" VLOOKUPCOUPLE = vlk End Function
[/vba]
Там, где нужны пустые ячейки - или формулу не протягивать, или позже удалить, или добавить доп.проверку наличия данных с ЕСЛИ().
Function VLOOKUPCOUPLE(Table As Variant, _ SearchColumnNum As Integer, _ SearchValue As Variant, _ RezultColumnNum As Integer, _ Separator_ As String, _ Optional BezPovtorov As Boolean = True)
'Table - таблица, где ищем 'SearchColumnNum - столбец, где ищем 'SearchValue - данные, которые ищем 'RezultColumnNum - колонка, откуда берём результат 'Separator_ - разделитель, желательно вводить с пробелом в конце 'BezPovtorov - если поставить 0, то будут выведены все повторяющиеся совпадения
Dim i As Long, tmp As String, vlk
If TypeName(Table) = "Range" Then Table = Intersect(Table.Parent.UsedRange, Table).Value If BezPovtorov Then With CreateObject("Scripting.Dictionary") For i = 1 To UBound(Table) If Table(i, SearchColumnNum) = SearchValue Then tmp = Table(i, RezultColumnNum) If tmp <> "" Then If Not .Exists(tmp) Then .Add tmp, 0& vlk = vlk & Separator_ & Table(i, RezultColumnNum) End If End If End If Next i End With Else For i = 1 To UBound(Table) If Table(i, SearchColumnNum) = SearchValue Then vlk = vlk & Separator_ & Table(i, RezultColumnNum) End If Next i End If If vlk > 0 Then vlk = Mid(vlk, Len(Separator_) + 1) Else vlk = "" VLOOKUPCOUPLE = vlk End Function
[/vba]
Там, где нужны пустые ячейки - или формулу не протягивать, или позже удалить, или добавить доп.проверку наличия данных с ЕСЛИ().
В своем файле открываете редактор VB, создаете модуль и вставляете код, написанный в сообщении 4 Hugo, затем в ячейку где должны начаться объединенные значения вставляете вторую формулу из того же значения и растягиваете ее до конца. Сама по себе формула работать не будет, поскольку не знает подобной функции VLOOKUPCOUPLE.
В своем файле открываете редактор VB, создаете модуль и вставляете код, написанный в сообщении 4 Hugo, затем в ячейку где должны начаться объединенные значения вставляете вторую формулу из того же значения и растягиваете ее до конца. Сама по себе формула работать не будет, поскольку не знает подобной функции VLOOKUPCOUPLE.shurikus
спасибо за помощь. всё работает. супер. нашёл этот форум ради пары вопросов. решил поиском. но вот и своя тема пригодилась отличный ресурс информации!
спасибо за помощь. всё работает. супер. нашёл этот форум ради пары вопросов. решил поиском. но вот и своя тема пригодилась отличный ресурс информации!sanders