Всем привет! Нужна помощь с макросом, необходимо сцепить ячейки в определённой последовательности и подставить знаки препинания, в примере более конкретно показано, буду благодарен за помощь
Всем привет! Нужна помощь с макросом, необходимо сцепить ячейки в определённой последовательности и подставить знаки препинания, в примере более конкретно показано, буду благодарен за помощьadamm1603
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] И там в примере ошибочка с " Узел 2 стыки 5 ,5* ,2 ,2* ,3 ,3* ,4 ,4* ,1 ,1* ,2 ,2* " - зачем повторяться?
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] И там в примере ошибочка с " Узел 2 стыки 5 ,5* ,2 ,2* ,3 ,3* ,4 ,4* ,1 ,1* ,2 ,2* " - зачем повторяться?
Функция не плохая, но проблема в том, что узлов у меня бывает больше сотни и вбивать каждый раз ручками очень долго, может есть какое то другое решение?
Функция не плохая, но проблема в том, что узлов у меня бывает больше сотни и вбивать каждый раз ручками очень долго, может есть какое то другое решение?adamm1603
Про то, что больше сотни, и бывает - можно было сразу сказать. Я ориентировался на то, что дано - есть ограниченное количество узлов, все они есть в данных, надобно слепитиь таким образом. Если же узлов много, неизвесно сколько и какие есть - тогда конечно лучше макросом делать, ну хотя бы выявить в словарь или коллекцию все существующие узлы, чтоб потом сгенерить строку для UDF Шучу, тогда уж сразу макросм всё и делать. Только куда Вы такую длиннючую строку далее применять будете?
Про то, что больше сотни, и бывает - можно было сразу сказать. Я ориентировался на то, что дано - есть ограниченное количество узлов, все они есть в данных, надобно слепитиь таким образом. Если же узлов много, неизвесно сколько и какие есть - тогда конечно лучше макросом делать, ну хотя бы выявить в словарь или коллекцию все существующие узлы, чтоб потом сгенерить строку для UDF Шучу, тогда уж сразу макросм всё и делать. Только куда Вы такую длиннючую строку далее применять будете?Hugo
Hugo, данная строка применяется в заключении (акте), сначала я делаю заявку, а после контроля (выполнения работ) мне печатают заключение (акт) и это происходит очень долго так как это всё в ручную, а с помощью макроса моментально sboy, спасибо буду пробовать!
Hugo, данная строка применяется в заключении (акте), сначала я делаю заявку, а после контроля (выполнения работ) мне печатают заключение (акт) и это происходит очень долго так как это всё в ручную, а с помощью макроса моментально sboy, спасибо буду пробовать!adamm1603
Всем привет! Поднимаю старую тему, так макрос, который мне любезно написал sboy, перестал работать выдаёт ошибку: "object doesn't support this property or method", гугл мне подсказал, что это "объект не поддерживает это свойство или метод", для меня лес дремучий... Пожскажите в чём проблема?
Всем привет! Поднимаю старую тему, так макрос, который мне любезно написал sboy, перестал работать выдаёт ошибку: "object doesn't support this property or method", гугл мне подсказал, что это "объект не поддерживает это свойство или метод", для меня лес дремучий... Пожскажите в чём проблема?adamm1603