Привет. Я не уверен, что правильно понял как у тебя расположены данные, ну, да, это не принципиально.
У мнея есть алгоритм, котоый делает следующее
1) копирует список значений на WorkSheet
2) строит список уникальных значений из имеющегося списка
3) уничтожает исходный список
Вот код. Думаю, его, немного переделав, можно использовать. Утверждать, что он супер эффективный не берусь, но работает хорошо.
С почтением,
Brudda
- Код: Выделить всё
' Creating a list of branches---------------------------------------------------
Sheets("Regions").Range("A1:A30000").Value = Sheets("Sheet1").Range("B2:B30000").Value
Worksheets("Regions").Range("A1").Sort key1:=Worksheets("Regions").Range("A1")
Set currentCell = Worksheets("Regions").Range("A1")
Do While Not IsEmpty(currentCell)
Set nextCell = currentCell.Offset(1, 0)
If nextCell.Value <> currentCell.Value Then
Row = Row + 1
Worksheets("Regions").Cells(Row, 2).Value = currentCell.Value
End If
Set currentCell = nextCell
Loop
Worksheets("Regions").Range("A1").EntireColumn.Delete