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
|