Sub example_01() 'добавление и сортировка элементов в ArrayList
Dim x, i&
x = Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value
Range("D1").CurrentRegion.ClearContents
With CreateObject("System.Collections.ArrayList")
 For i = 1 To UBound(x)
 If Not .Contains(x(i, 1)) Then .Add x(i, 1) 'добавляем только уникальные элементы
 Next i
 .Sort 'сортируем
 Range("D1").Resize(.Count).Value = Application.Transpose(.ToArray)
 .Reverse 'изменяем порядок элементов
 Range("E1").Resize(.Count).Value = Application.Transpose(.ToArray)
End With
End Sub
Sub example_02() 'удаление элементов из ArrayList
Dim x, i&
x = Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value
Range("D1").CurrentRegion.ClearContents
With CreateObject("System.Collections.ArrayList")
 For i = 1 To UBound(x): .Add x(i, 1): Next i
 MsgBox .Count
 
 .Add "rty": .TrimToSize ' TrimToSize работает, но нужно ли?
 MsgBox .Count
 
 .Remove "Заголовок" 'удалить элемент по значению (если его нет, ошибка не возникает)
 MsgBox .Count
 
 .RemoveAt 3 'удалить элемент с индексом 3 (четвертый по счету)
 MsgBox .Count
 ' .RemoveRange startIndex, Count
 .RemoveRange 2, 3 'удалить три элемента, начиная со второго индекса (третьего по счету)
 MsgBox .Count
 
 Range("D1").Resize(.Count).Value = Application.Transpose(.ToArray)
End With
End Sub
Sub example_03() 'извлечение/вставка элементов ArrayList
Dim x, i&, newList As Object
x = Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value
Range("D1").CurrentRegion.ClearContents
Set newList = CreateObject("System.Collections.ArrayList")
With CreateObject("System.Collections.ArrayList")
 For i = 1 To UBound(x): .Add x(i, 1): Next i
 .Insert 0, "Заголовок" 'вставить в 1-ю позицию (индекс 0) элемент/объект "Заголовок"
 Range("D1").Resize(.Count).Value = Application.Transpose(.ToArray)
 MsgBox "Первый элемент: " & .Item(0) & vbCrLf & _
 "последний элемент: " & .Item(.Count - 1) & vbCrLf & _
 "третий элемент : " & .Item(2)
 newList.InsertRange 0, .GetRange(2, 3) 'вставить в newList диапазон из 3-х эл-тов, начиная со 2-го индекса
 .Clear 'очистить ArrayList
End With
Range("E1").Resize(newList.Count).Value = Application.Transpose(newList.ToArray)
MsgBox "Первый элемент newList: " & newList(0) & vbCrLf & _
 "последний элемент newList: " & newList(newList.Count - 1) & vbCrLf & _
 "второй элемент newList: " & newList(1)
Set newList = Nothing
End Sub
Sub example_04() 'поиск в ArrayList
'только точное соответствие и с учетом регистра; возвращает -1, если эл-нт не найден
Dim x, i&
x = Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value
With CreateObject("System.Collections.ArrayList")
 For i = 1 To UBound(x): .Add x(i, 1): Next i
 'aList.IndexOf(object, ctartIndex)
 ' ищем Иванова, начиная от начала (с 3-го индексас) до конца списка
 MsgBox "Индекс элемента 'Иванов': " & .IndexOf("Иванов", 3)
 'aList.LastIndexOf(object)
 ' ищем Иванова, начиная с конца списка
 MsgBox "Индекс элемента 'Иванов': " & .LastIndexOf("Иванов")
 
 .Clear 'очистить ArrayList
End With
End Sub
 |