Повторы в столбце - собрать значения.

[VictorM]

VictorM, в сообщении #12 есть ещё код.

Внес вот такие изменения в Ваш код

myArray_3() = Range("A" & myFirstRow & ":A" & myEnd)
'
'
'
'
'4.1.2. В массив "myArray_2" дописываем замечание.
                'Удаляем данные и из массива "myArray_2".
                If IsEmpty(myArray_2(j, 1)) = False Then

                    If IsEmpty(myArray_2(i, 1)) = False Then
                        myArray_2(i, 1) = myArray_3(i, 1) & "-" & myArray_2(i, 1) & "; " & myArray_3(j, 1) & "-" & myArray_2(j, 1)
                        '                        myArray_2(i, 1) = myArray_2(i, 1) & "; " & myArray_2(j, 1)
                    Else
                        myArray_2(i, 1) = myArray_3(j, 1) & "-" & myArray_2(j, 1)
                        '                        myArray_2(i, 1) = myArray_2(j, 1)
                    End If

                    myArray_2(j, 1) = Empty
                    myArray_3(j, 1) = Empty
                End If

Получил почти то, что нужно и работает быстро, но вот если в списке, допустим, 3 повтора фамилии и первая строка заметок пустая, получается вот такая сборная строка 08.12.2007-13.06.2007-в; 25.06.2008-ф
где 08.12.2007 - дата в строке с пустой заметкой.
если же в тех же трех повторах фамилии пустая вторая строка, все срабатывает отлично.
Пока не могу разобраться.

[Скрипт]

Код написан для Excel-книги из сообщения #1:

Sub Procedure_1()

    'Указываем строку, с которой начинаются данные.
    Const myFirstRow As Long = 7
    
    Dim myA() As Variant, myC() As Variant, myI() As Variant
    Dim myEnd As Long
    Dim myUbound As Long
    Dim i As Long, j As Long
    
    '1. Отключаем то, что может тормозить работу кода.
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    '2. Узнаём номер строки с последним "ФИО".
    'What:="?" - знак вопроса в данном случае - это специальный символ.
    'SearchDirection:=xlPrevious - поиск с конца в начало.
    myEnd = Columns("C").Find(What:="?", LookIn:=xlFormulas, LookAt:=xlPart, _
        SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
        MatchCase:=False, SearchFormat:=False).Row

    '3. Берём данные в массивы, т.к. с массивами код быстрее
    'работает, чем с объектами. Ячейки в Excel являются объектами.
    myA() = Range("A" & myFirstRow & ":A" & myEnd)
    myC() = Range("C" & myFirstRow & ":C" & myEnd)
    myI() = Range("I" & myFirstRow & ":I" & myEnd)
    
    '4. Узнаём количество строк в массиве.
    'Чтобы в коде каждый раз это не делать - может быстрее будет.
    myUbound = UBound(myC, 1)
    
    '5. Двигаемся по массиву "myC" с первой строки и до
        'предпоследней, т.к. последнюю строку не с чем сравнивать.
    For i = 1 To myUbound - 1 Step 1
    
        'Если пусто.
        'Код удаляет повторяющиеся "ФИО" из массива "myC".
        If IsEmpty(myC(i, 1)) = True Then
            'Переход к следуещему "ФИО".
            GoTo metka
        End If
        
        '5.1. Если в столбце "I" есть данные, то добавляем туда дату.
        If IsEmpty(myI(i, 1)) = False Then
            myI(i, 1) = myA(i, 1) & " - " & myI(i, 1)
        End If
        
        '5.2. Просматриваем тот же самый массив "myC", но
            'не с начала, а относительно очередного элемента.
        For j = i + 1 To myUbound Step 1
        
            If myC(i, 1) = myC(j, 1) Then
            
                '5.2.1. Удаляем из массива "myC" текущий элемент, чтобы пустой элемент
                    'в массиве пропускать.
                myC(j, 1) = Empty
                
                '5.2.2. В массив "myI" дописываем замечание.
                If IsEmpty(myI(j, 1)) = False Then
                
                    If IsEmpty(myI(i, 1)) = False Then
                        myI(i, 1) = myI(i, 1) & "; " & myA(j, 1) & " - " & myI(j, 1)
                    Else
                        myI(i, 1) = myA(j, 1) & " - " & myI(j, 1)
                    End If
                    
                    '5.2.3. Удаляем данные из массива "myI", т.к.
                        'потом будем вставлять на Excel-лист массив "myI".
                    myI(j, 1) = Empty
                    
                End If
                
            End If
            
        Next j
metka:

    Next i
    
    '6. Выводим изменённый массив на лист.
    Range("I" & myFirstRow & ":I" & myEnd).Value = myI()
    
    '7. Включаем то, что отключали.
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

    '8. Сообщение, что работа кода завершена.
    MsgBox "Работа кода завершена!", vbInformation
  
End Sub

[VictorM]

6650 строк - 1,5 сек!
Все отлично сработало.
Спасибо за помощь!