Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Копилка идей
Страницы: 1
RSS
Сцепить данные в столбце по условию повторения данных в соседнем. [VDM], VDM
 
#1
16.09.2012 02:29:49
[VDM]
Здравствуйте.
Уважаемые Форумчане.
Подскажите пожалуйста, возможно ли записать формулу (возможно нужна формула массива??), которая сможет сцепить построчно диапазон данных в столбце, заданных повторением данных в соседнем столбце.
Файл прилагаю.
Спасибо.
 
 
 
#2
16.09.2012 02:31:22
[Hugo]
UDF:
=PERSONAL.XLS!VLOOKUPCOUPLE($A$2:$B$13;1;A2;2;", ")


Код
Function VLOOKUPCOUPLE(Table As Range, SearchColumnNum As Integer, SearchValue As Variant, _
RezultColumnNum As Integer, Separator_ As String)
'Table - таблица, где ищем
'SearchColumnNum - столбец, где ищем
'SearchValue - данные, которые ищем
'RezultColumnNum - колонка, откуда берём результат
'Separator_ - разделитель, желательно вводить с пробелом в конце

Dim i As Integer
Dim iCount As Integer

For i = 1 To Table.Rows.Count
If Table.Cells(i, SearchColumnNum) = SearchValue Then
If VLOOKUPCOUPLE <> "" Then
VLOOKUPCOUPLE = VLOOKUPCOUPLE & Separator_ & Table.Cells(i, RezultColumnNum)
Else
VLOOKUPCOUPLE = Table.Cells(i, RezultColumnNum)
End If
End If
Next i
If VLOOKUPCOUPLE = 0 Then VLOOKUPCOUPLE = ""
End F unction
Да, вот только пестроту наводите вручную, ну или макросом, но тогда формулу можно не городить, а сразу всё делать им.
 
 
 
#3
16.09.2012 02:32:17
[VDM]
Здравствуйте!
Я думаю очень многим бы подошло, задача как мне кажется достаточно актуальная и хоть раз тот, кто занимается обработкой и анализом текстовых данных с ней сталкивался или столкнётся в будущем.
Ещё раз хочу отблагодарить автора функции, Hugo - браво!
Опробовал сегодня на рабочем файле (2000 строк)- отлично работает, кроме того функция оказалась невосприимчива к сортировке.
 
 
 
#4
16.09.2012 02:33:01
[Hugo]
Только там в функции строка Dim iCount As Integer лишняя, это остатки от VLOOKUP2 или 3, не помню, какую именно брал за основу... :)
Ну и если в копилку, то может надо переделать, как http://www.planetaexcel.ru/forum.php?thread_id=16634
The_Prist переделал, чтоб с закрытыми файлами работало, я не берусь, опыта маловато... ещё накосячу...
 
 
 
#5
16.09.2012 02:34:11
[The_Prist]
Ну вот вариант с закрытыми книгами:

Код
Function VLOOKUPCOUPLE(Table As Variant, SearchColumnNum As Integer, SearchValue As Variant, _
RezultColumnNum As Integer, Separator_ As String)
'Table - таблица, где ищем
'SearchColumnNum - столбец, где ищем
'SearchValue - данные, которые ищем
'RezultColumnNum - колонка, откуда берём результат
'Separator_ - разделитель, желательно вводить с пробелом в конце

Dim i As Long
Select Case TypeName(Table)
Case "Range"
For i = 1 To Table.Rows.Count
If Table.Cells(i, SearchColumnNum) = SearchValue Then
If VLOOKUPCOUPLE <> "" Then
VLOOKUPCOUPLE = VLOOKUPCOUPLE & Separator_ & Table.Cells(i, RezultColumnNum)
Else
VLOOKUPCOUPLE = Table.Cells(i, RezultColumnNum)
End If
End If
Next i
Case "Variant()"
For i = 1 To UBound(Table)
If Table(i, SearchColumnNum) = SearchValue Then
If VLOOKUPCOUPLE <> "" Then
VLOOKUPCOUPLE = VLOOKUPCOUPLE & Separator_ & Table(i, RezultColumnNum)
Else
VLOOKUPCOUPLE = Table(i, RezultColumnNum)
End If
End If
Next i
End Select
If VLOOKUPCOUPLE = 0 Then VLOOKUPCOUPLE = ""
End F unction
Изменено: Юрий М - 16.09.2012 02:34:58
 
 
 
#6
23.12.2012 13:23:37
На старом форуме в копилке есть продолжение:
UDF VLOOKUPCOUPLE() - В продолжение "Сцепить данные в столбце по условию ..."
 
 
 
#7
20.03.2014 00:51:31
По просьбе Игоря (Hugo) добавляю:
Код
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
Обсуждалось ЗДЕСЬ
 
 
 
Страницы: 1
Наверх