У меня массив примерно из 5000 строк. 2 колонки: 1 индикатор и 2 значение. Нужно по значению сделать объединение индикаторов. Пример прикрепляю. Правда упрощенный вариант. Причём нужно, чтобы индикаторы вычислялись и объединялись в одной ячейке. Помогите решить задачку, плиз.
У меня массив примерно из 5000 строк. 2 колонки: 1 индикатор и 2 значение. Нужно по значению сделать объединение индикаторов. Пример прикрепляю. Правда упрощенный вариант. Причём нужно, чтобы индикаторы вычислялись и объединялись в одной ячейке. Помогите решить задачку, плиз.Ksenya
Стандартными функциями сделать трудно. Проще использовать UDF, например такую:
код в модуле (или в надстройке): (при участии The_Prist и RAN) [vba]
Code
Function VLOOKUPCOUPLE6(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, oDict As Object, tmp As String, vlk
If TypeName(Table) = "Range" Then Table = Table.Value
If BezPovtorov Then Set oDict = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Table) If Table(i, SearchColumnNum) = SearchValue Then tmp = Table(i, RezultColumnNum) If tmp <> "" Then If Not oDict.Exists(tmp) Then oDict.Add tmp, 0& vlk = vlk & Separator_ & Table(i, RezultColumnNum) End If End If End If Next i
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 = "" VLOOKUPCOUPLE6 = vlk End Function
Стандартными функциями сделать трудно. Проще использовать UDF, например такую:
код в модуле (или в надстройке): (при участии The_Prist и RAN) [vba]
Code
Function VLOOKUPCOUPLE6(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, oDict As Object, tmp As String, vlk
If TypeName(Table) = "Range" Then Table = Table.Value
If BezPovtorov Then Set oDict = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Table) If Table(i, SearchColumnNum) = SearchValue Then tmp = Table(i, RezultColumnNum) If tmp <> "" Then If Not oDict.Exists(tmp) Then oDict.Add tmp, 0& vlk = vlk & Separator_ & Table(i, RezultColumnNum) End If End If End If Next i
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 = "" VLOOKUPCOUPLE6 = vlk End Function
Если речь идёт о том, чтобы сделать это один раз и забыть, то вот мой алгоритм:
1. Сортируете вручную таблицу по возрастанию: 1-й ключ - Значение, 2-й ключ - Индикатор. 2. В колонки C "Конец Значения" и D "Составной индикатор" вводите две простых формулы: [vba]
Code
С2: =B3<>B2 D2: =ЕСЛИ(B2<>B1;A2;D1&", "&A2)
[/vba] 3. Включаете фильтр по колонке "Конец Значения" = ИСТИНА. 4. Копируете данные специальной вставкой "как значения" в другое место.
Если речь идёт о том, чтобы сделать это один раз и забыть, то вот мой алгоритм:
1. Сортируете вручную таблицу по возрастанию: 1-й ключ - Значение, 2-й ключ - Индикатор. 2. В колонки C "Конец Значения" и D "Составной индикатор" вводите две простых формулы: [vba]
Code
С2: =B3<>B2 D2: =ЕСЛИ(B2<>B1;A2;D1&", "&A2)
[/vba] 3. Включаете фильтр по колонке "Конец Значения" = ИСТИНА. 4. Копируете данные специальной вставкой "как значения" в другое место.Gustav
Файл xla с функцией создала, запустила. И в самом файле в исходном тексте функцию прописала. Но всё равно не работает. Файл прилагаю. Помогите. пожалуйста, понять, что не так. Уже второй час голову ломаю. Опыта работы в VBA у меня совсем нет. Но уже вдохновилась и буду постепенно вникать.
Файл xla с функцией создала, запустила. И в самом файле в исходном тексте функцию прописала. Но всё равно не работает. Файл прилагаю. Помогите. пожалуйста, понять, что не так. Уже второй час голову ломаю. Опыта работы в VBA у меня совсем нет. Но уже вдохновилась и буду постепенно вникать.Ksenya
Подправил, заработало. Вы не совсем так и не совсем туда функцию добавили. С непривычки Сейчас формула засчитала, изучайте, говорите спасибо Hugo.
Подправил, заработало. Вы не совсем так и не совсем туда функцию добавили. С непривычки Сейчас формула засчитала, изучайте, говорите спасибо Hugo.Gustav
Я там выше всё поменял - теперь новый код, и другое название Название можете поставить любое - замените в коде VLOOKUPCOUPLE6 два раза на что понравится Теперь есть опция исключения повторов. Работает и с закрытой книгой, только диапазон нужно указывать не целыми столбцами.
Я там выше всё поменял - теперь новый код, и другое название Название можете поставить любое - замените в коде VLOOKUPCOUPLE6 два раза на что понравится Теперь есть опция исключения повторов. Работает и с закрытой книгой, только диапазон нужно указывать не целыми столбцами.Hugo