Если "частично одинаковых значений в столбце" не очень много, то можно попробовать "Автофильтр" по текстовому условию "Начинается с ..". Далее выделяем оставшиеся ячейки и транспонируем. Это только в 2007 и выше. В 2003 не реализован автофильтр по текстовому условию.
Хотя, если значения идут подряд - то смысла в автофильтре нет...
Если "частично одинаковых значений в столбце" не очень много, то можно попробовать "Автофильтр" по текстовому условию "Начинается с ..". Далее выделяем оставшиеся ячейки и транспонируем. Это только в 2007 и выше. В 2003 не реализован автофильтр по текстовому условию.
Хотя, если значения идут подряд - то смысла в автофильтре нет...amur84
Новый день. А что успел сделать ты?
Сообщение отредактировал amur84 - Вторник, 13.11.2012, 17:56
Я бы делал так (чтоб макрос не писать): 1. вытянул фомулой в столбец строки-критерии - т.е. часть до "_" 2. отобрал из них в столбец уникальные 3. с помощью UDF vlookupcouple() http://www.planetaexcel.ru/forum.php?thread_id=45721 на основе этих двух столбцов в третьем получил результат.
Я бы делал так (чтоб макрос не писать): 1. вытянул фомулой в столбец строки-критерии - т.е. часть до "_" 2. отобрал из них в столбец уникальные 3. с помощью UDF vlookupcouple() http://www.planetaexcel.ru/forum.php?thread_id=45721 на основе этих двух столбцов в третьем получил результат.Hugo
Да, можно словарь по первой части, и каждому ключу в Item коллекцию его значений (хотя можно и сразу в Item собирать итоговую строку). Потом в конце всеё сливаем в строку через разделитель. Ну а если UDF под задачу, то вообще элементарно - если начало просматриваемой ячейки и критерий (который можно извлечь тут же кодом из указанной ячейки) совпадают - собираем строку.
[vba]
Code
Function couple(krit$, r As Range, razd$, sep As String) As String Dim el, s$ couple = "" krit$ = Split(krit$, razd, 2)(0) For Each el In r.Value If Left(el, Len(krit)) = krit Then s = s & sep & el Next couple = Mid(s, Len(sep) + 1) End Function
[/vba]
Да, можно словарь по первой части, и каждому ключу в Item коллекцию его значений (хотя можно и сразу в Item собирать итоговую строку). Потом в конце всеё сливаем в строку через разделитель. Ну а если UDF под задачу, то вообще элементарно - если начало просматриваемой ячейки и критерий (который можно извлечь тут же кодом из указанной ячейки) совпадают - собираем строку.
[vba]
Code
Function couple(krit$, r As Range, razd$, sep As String) As String Dim el, s$ couple = "" krit$ = Split(krit$, razd, 2)(0) For Each el In r.Value If Left(el, Len(krit)) = krit Then s = s & sep & el Next couple = Mid(s, Len(sep) + 1) End Function
Sub www() Dim arr(), i As Long, it, arr1, m arr = Range([A1], Cells(Rows.Count, 1).End(xlUp).Offset(0, 1)).Value With CreateObject("Scripting.Dictionary") For i = LBound(arr, 1) To UBound(arr, 1) it = Mid(arr(i, 1), 1, 3) .Item(it) = .Item(it) & it & "_" & Mid(arr(i, 1), 5, 1) & ";" Next i ReDim arr(1 To .Count, 1 To 1) i = 1 For Each it In .Keys arr1 = Split(it, "_") m = arr1(0) & .Item(it) arr(i, 1) = Mid(m, 4, Len(m) - 4) i = i + 1 Next it End With [b1].Resize(i - 1, 1).Value = arr End Sub
[/vba]
У меня так получился [vba]
Code
Sub www() Dim arr(), i As Long, it, arr1, m arr = Range([A1], Cells(Rows.Count, 1).End(xlUp).Offset(0, 1)).Value With CreateObject("Scripting.Dictionary") For i = LBound(arr, 1) To UBound(arr, 1) it = Mid(arr(i, 1), 1, 3) .Item(it) = .Item(it) & it & "_" & Mid(arr(i, 1), 5, 1) & ";" Next i ReDim arr(1 To .Count, 1 To 1) i = 1 For Each it In .Keys arr1 = Split(it, "_") m = arr1(0) & .Item(it) arr(i, 1) = Mid(m, 4, Len(m) - 4) i = i + 1 Next it End With [b1].Resize(i - 1, 1).Value = arr End Sub