помощь в написании макроса

[frogy]

Помогите советом в написании части макроса.
Запросом получаю данные. в первом столбце имя фамилия, второй номера телефонов, у некоторых сотрудников по несколько телефонов. соответственно в первом столбце данные повторяются
Вопрос как соединить повторяющиеся фамилии в одну ячейку и что бы телефоны все добавились напротив этой фамилии
или есть другой вариант, телефоны у сотрудников разделяю по ячейкам(получается лесенка- если их несколько) как собрать в одну строчку такие строчки?

[Aent]

1) Каким запросом - к кому ?
2) Выложите пример итогового файла.

[frogy]

sql-запрос
в файлике, лист исходник это как я получаю данные
но потом их надо разделить по ячейкам и соеденить вместе

[SAS888]

Посмотрите вложение. Запустите макрос "Main".

[frogy]

клёво, это мне тоже пригодится, но видимо не так поняли меня
то что исходник это я получаю таблицу после запроса, одинаковые ячейки надо соеденить так чтобы фамилия оставалась одна, а телефоны добавлялись в ячейку через ","
А то что лесенкой это я сам разделяю для того чтобы, опять же соеденить ячейки, но чёт не выходит "каменный цветок"

[Aent]

Код: Выделить всё

Public Sub TelJoiner()
    Dim i As Long
    Dim iMax As Long
    Dim s As String
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    With ThisWorkbook.Worksheets("Исходник")
        iMax = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
        s = vbNullString
        For i = iMax To 2 Step -1
           With .Cells(i, 1)
               If .Value = .Offset(-1, 0).Value Then
                   s = s & ";" & .Offset(0, 1).Value
                   .EntireRow.Delete
               ElseIf Len(s) > 0 Then
                   s = s & ";" & .Offset(0, 1).Value
                   If Left$(s, 1) = ";" Then s = Mid$(s, 2)
                   .Offset(0, 1).Value = s
                   s = vbNullString
               End If
            End With
        Next i
        With .Columns(2)
            .HorizontalAlignment = xlLeft
            .AutoFit
        End With
    End With
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Для "лесенки" аналогично

[SAS888]

Все-таки, считаю, что работать с элементами массива более рационально, чем с ячейками рабочего листа Excel. Для решения задачи, можно, например, использовать код:

Код: Выделить всё

Sub TelInStr()
    Dim i As Long, j As Long, a(), b() As String, x As New Collection
    Application.ScreenUpdating = False
    With Sheets("Исходник")
        a = .Range(.[A2], .Cells(Rows.Count, "B").End(xlUp)).Value
        ReDim b(1 To UBound(a, 1), 1 To 2): j = 0
        For i = 1 To UBound(a, 1)
            On Error Resume Next: x.Add a(i, 1), CStr(a(i, 1))
            If Err = 0 Then
                j = j + 1: b(j, 1) = a(i, 1): b(j, 2) = a(i, 2)
            Else: b(j, 2) = b(j, 2) & ", " & a(i, 2): On Error GoTo 0
            End If
        Next
        .Range(.[A2], .Cells(UBound(b, 1) + 1, UBound(b, 2))).Value = b: .Columns(2).AutoFit
    End With
End Sub

P.S. Необходимо заметить: предполагается, что данные предварительно отсортированы по 1-му столбцу. Если нет, можно воспользоваться сортировкой массива (пример кода можно взять из моего первого ответа).

[Aent]

SAS888,
А чем вас не устраивает работа с ячейками?
Не думаю что c массивами это будет быстрее
1. Коллекции работают достаточно медленно
2. При таком подходе нужно ещё удалять оставшиеся внизу листа старые строки
или чистить лист сразу после чтения данных в массив

[SAS888]

1. Коллекции работают достаточно медленно

Если формировать коллекцию, перебирая ячейки, то это даже медленнее, чем брать значение ячейки непосредственно. Но если формировать коллекцию из массива, то это существенно быстрее. После этого, мы с созданной коллекцией больше не работаем.

2. При таком подходе нужно ещё удалять оставшиеся внизу листа старые строки или чистить лист сразу после чтения данных в массив

В данном случае этого не требуется, т.к. мы формируем массив a, включающий все используемые строки в столбцах "A" и "B", затем определяем массив b той же размерности и в процессе выполнения процедуры, заполняем его. Затем в тот же диапазон, откуда формировали массив a, вставляем массив b, который полностью заменит все значения в этом диапазоне. Если массив b заполнен не полностью, то значения заменятся на пустые.

[Aent]

SAS888, я не поленился и померял на тесте в 400 строк.
Ваш код действительно существенно быстрее.