На вход макроса поступает диапазон обработки, задаваемый переменной Adres. В подпрограмме производится перебор ячеек диапазона, и командой
NoDupes.Add Cell.Value, CStr(Cell.Value) осуществляется выборка только уникальных элементов в коллекцию NoDupes. Ключ сравнения задан в команде после запятой.
Форма UserForm2 создана лишь для отладки и получения результирующей выборки. Она содержит окно Listbox1 и две метки Label1 и Label2.
Форма Userform2 и контрол Listbox1 могут быть использованы неоднократно для выборки нужных записей. Для учебного процесса это могут быть ФИО и параметры, предметы, часы, оценки и т.д.
Sub RemoveDuplicates(Adres)
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer
Dim j As Integer
Dim Swap1, Swap2, Item
‘ Элементы находятся в диапазоне A1:A105
Set AllCells = Range(Adres)
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
Next Cell
On Error GoTo 0
With UserForm2
.Label1.Caption = “Всего элементов: ” & AllCells.Count
.Label2.Caption = “Уникальных элементов: ” & NoDupes.Count
End With
For i = 1 To NoDupes.Count – 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) > NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, before:=j
NoDupes.Add Swap2, before:=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i
‘ Добавление уникальных элементов в ListBox
For Each Item In NoDupes
UserForm2.ListBox1.AddItem Item
Next Item
Отображение окна UserForm
‘UserForm2.Show
End Sub