powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Удаление одинаковых записей из массива
30 сообщений из 30, показаны все 2 страниц
Удаление одинаковых записей из массива
    #36314892
andMegaM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Допустим имеется массив
Код: plaintext
1.
2.
3.
Sub MyArrays()
Dim NewMyArray()
MyArray = Array( 12 ,  12 ,  12 ,  150 ,  150 )
End Sub
Как из исходного массива удалить повторяющиеся значения и записать новый массив?
Т.е. необходимо чтобы новый массив был
Код: plaintext
NewMyArray = Array( 12 ,  150 ) 
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36314942
m
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
m
Гость
можно переносить по одному значению из старого в новый массив, при этом проверять нет ли такого значения в новом.
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36314950
andMegaM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
А как сделать поиск значения в массиве?
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36315032
MaximuS_G
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
В этом варианте есть один нюанс, верхняя граница массива aNew будет на 1 элемент больше, чем есть фактически. Наверняка это легко обходится, просто сейчас нет времени думать :)
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
Dim aOld
Dim aNew()
Dim YN As Boolean
Dim i As Long
Dim j As Long


aOld = Array( 1 ,  1 ,  2 ,  3 ,  5 ,  3 )

YN = False

ReDim aNew( 1  To  1 )

For i =  1  To UBound(aOld)
    For j =  1  To UBound(aNew)
    If aOld(i) = aNew(j) Then
    YN = True
    Exit For
    End If
    Next
    If YN = False Then
    ReDim Preserve aNew( 1  To UBound(aNew) +  1 )
    aNew(UBound(aNew) -  1 ) = aOld(i)
    End If
Next i

'вывод
For i =  1  To UBound(aNew)
Cells(i,  1 ).Value = aNew(i)
Next i
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36319168
A-Nik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
MaximuS_G, круто, конечно, но лучше, всё таки, так:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
Sub MyArrays()
Dim NewMyArray(), MyArray()
Dim Col As New Collection
On Error Resume Next
MyArray = Array( 12 ,  12 ,  12 ,  150 ,  150 )
For Each a In MyArray
  Col.Add a, CStr(a)
Next a
'Если работа с коллекцией далее неприемлема, то перебросить её в массив
ReDim NewMyArray( 1  To Col.Count)
For i& =  1  To Col.Count
  NewMyArray(i) = Col(i)
Next
'Вывод
Range("A1").Resize(, Col.Count) = NewMyArray 'по столбцам
Range("A3").Resize(Col.Count) = Application.Transpose(NewMyArray)  'по строкам
End Sub
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36319211
m
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
m
Гость
A-NikMaximuS_G, круто, конечно, но лучше, всё таки, так:
Да, у Вас намного быстрее и интереснее, но не сказал бы что правильнее. Мне кажется использование On Error Resume Next не совсем правильно. Всего лишь мое мнение :)
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36319647
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Еще вариант
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
Sub test()
Dim aOld, aNew, i As Long, str As String

aOld = Array( 1 ,  1 ,  2 ,  3 ,  5 ,  3 )
str = ""
For i =  1  To UBound(aOld)
  If InStr( 1 , str, aOld(i)) =  0  Then str = str & aOld(i) & "|"
Next i
aNew = Split(str, "|")

'Вывод
Range("A1").Resize(, UBound(aNew) +  1 ) = Application.Transpose(Application.Transpose(aNew)) 'по столбцам
Range("A3").Resize(UBound(aNew) +  1 ) = Application.Transpose(aNew)  'по строкам

End Sub
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36320341
A-Nik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Вот ещё вариант ...
Ощутите разницу
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36321159
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Спасибо, хорошее сравнение. И коды интересные, пригодятся.
Я тут на досуге погонял на реальных 11000+ значениях ( с пустыми ячейками в конце диапазона), из которых 2999 уникальных значащих + 1 уникальный пустой элемент (т.е. общее количество элементов массива 3000).
Полученный массив выгружал рядом в столбец B.
Коды чуть подправил, a на i поменял, Dictionary без On Error Resume Next не хотел работать...
Код Deggassad единственный игнорирует пробелы - у меня в списке затесались две пустые ячейки, так вот код Deggassad их пропустил, но зато одну пустую ячейку вставил в конце (это просто пустой элемент в конце массива, после "|"), остальные варианты взяли как уникальное одну пустоту и поместили её в порядке очереди. Немного это сбивало с толку, пока нашёл причину - количество элементов вроде одинаковое, а количество заполненных ячеек разное...
Так что вот, в коде Deggassad пустоту в конце выкинуть легко (в примере выкинул) и в массиве её уже нет, в других вариантах она в массиве так и сидит, надо учитывать.
По времени:
Degassad 4,140125
For Each 1,218250
For i 1,733500
Dictionary 1,140375

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
Sub btnDeggasad_Click()
Dim aOld, aNew, i As Long, str As String
Start! = Timer
aOld = [a1:a12000]
str = ""

For i =  1  To UBound(aOld)
    If i =  1  Then
     If InStr( 1 , str, aOld(i,  1 )) =  0  Then str = aOld(i,  1 )
    Else
        If InStr( 1 , str, aOld(i,  1 )) =  0  Then str = str & "|" & aOld(i,  1 )
    End If
Next i
aNew = Split(str, "|")

For i =  0  To UBound(aNew)
    Cells(i +  1 ,  2 ) = aNew(i)
Next
  Cells( 2 ,  5 ) = Timer - Start
  Cells( 2 ,  6 ) = UBound(aNew) +  1 

[CalcTime] = Timer - Start
End Sub

Sub btnCollections1_Click()
Dim NewMyArray(), MyArray
Dim Col As New Collection
Start! = Timer
On Error Resume Next
MyArray = [a1:a12000]
For Each a In MyArray
  Col.Add a, CStr(a)
Next a
'Если работа с коллекцией далее неприемлема, то перебросить её в массив
'ReDim NewMyArray(1 To Col.Count)
i =  1 
For Each a In Col
'  NewMyArray(i) = a
  Cells(i,  2 ) = a
  i = i +  1 
Next
  Cells( 3 ,  5 ) = Timer - Start
  Cells( 3 ,  6 ) = Col.Count
[CalcTime] = Timer - Start
End Sub

Sub btnCollections2_Click()
Dim NewMyArray(), MyArray
Dim Col As New Collection
Start! = Timer
On Error Resume Next
MyArray = [a1:a12000]
For Each a In MyArray
  Col.Add a, CStr(a)
Next a
'Если работа с коллекцией далее неприемлема, то перебросить её в массив
ReDim NewMyArray( 1  To Col.Count)
For i =  1  To Col.Count
'  NewMyArray(i) = Col(i)
    Cells(i,  2 ) = Col(i)
Next
  Cells( 4 ,  5 ) = Timer - Start
  Cells( 4 ,  6 ) = Col.Count
[CalcTime] = Timer - Start

End Sub

Sub btnDictionary_Click()
Dim NewMyArray, MyArray, D
Start! = Timer
On Error Resume Next
Set D = CreateObject("Scripting.Dictionary")
MyArray = [a1:a12000]
For Each a In MyArray
  D.Add CStr(a), a
Next a
NewMyArray = D.Items
For i =  0  To UBound(NewMyArray)
    Cells(i +  1 ,  2 ) = NewMyArray(i)
Next
  Cells( 5 ,  5 ) = Timer - Start
  Cells( 5 ,  6 ) = UBound(NewMyArray) +  1 
[CalcTime] = Timer - Start
End Sub
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36321494
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Код Deggassad единственный игнорирует пробелы - как оказалось, не совсем - если первая ячейка диапазона пустая, то она заносится в массив пустой. Но это конечно можно обойти дополнительной проверкой перед занесением в str.
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36321691
A-Nik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Hugo121, у меня от шока нет слов !
Это ж надо было так затормозить работу циклов !


1. Что вам мешало оставить вывод значений массива однима махом, а не в цикле? Сделать это можно либо через транспонирование, как в наших с Деггасадом примерах, либо черз объявление двумерного массива, у которого второе измерение равно 1. Вот пример для варианта с коллекцией:
Код: plaintext
1.
2.
3.
4.
5.
6.
ReDim NewMyArray( 1  To Col.Count,  1  To  1 )
i =  1 
For Each a In Col
  NewMyArray(i,  1 ) = a
  i = i +  1 
Next
Range("B1").Resize(UBound(NewMyArray)) = NewMyArray

2. Вариант Деггасада вы тоже затормозили, вставив проверку в тело цикла. От пустого последнего/первого элемента можно избавиться так:
Код: plaintext
1.
2.
3.
4.
5.
str = ""
For i =  1  To UBound(aOld)
  If InStr( 1 , str, aOld(i)) =  0  Then str = str & aOld(i) & "|"
Next i
aNew = Split(LEFT(str,LEN(str)- 1 ), "|")
Range("B1").Resize(UBound(aNew) +  1 ) = Application.Transpose(aNew)
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36321716
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Я уже понял, что мой вариант не самый быстрый по скорости, но вдруг кому то нравится, так вот смотрите там была ошибка в искомом параметре, сразу в глаза не бросилось
Вот исправленный код.

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
Sub btnDeggasad_Click()
Dim aOld, aNew, x, i As Long, str As String
Start! = Timer
aOld = [a1:a10000]
str = ""
For i =  1  To UBound(aOld)
  x = aOld(i,  1 ) & "|"
  If InStr( 1 , str, x) =  0  Then str = str & x
Next i
aNew = Split(str, "|")
Range("B1").Resize(UBound(aNew) +  1 ) = Application.Transpose(aNew)
[CalckTime] = Timer - Start
End Sub
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36321758
m
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
m
Гость
Зато он оригинальный :)...
Код от A-Nik однозначно будет быстрее, так как он использует коллекции, а коллекции в разы быстрее обрабатываются чем массивы типа Array.
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36321773
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Да я тоже только учусь :) Понимаю, что не быстрый вывод, ну так вот Вы показали, как лучше, да и тема развилась в хороший учебный пример :)
Мне бы год назад это почитать, когда я только подступался к массивам...
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36321795
A-Nik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
mКод от A-Nik однозначно будет быстрее, так как он использует коллекции, а коллекции в разы быстрее обрабатываются чем массивы типа Array.
Очень интересное заключение....
A можно поинтересоваться почему так ?
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36321931
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Немного изменил код, сделал его более красивым (на мой взгляд), большей скорости выдавить не удалось

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
Dim aOld, aNew, x, i As Long, str As String
Start! = Timer
aOld = [transpose(a1:a10000)]
str = aOld( 1 ) & "|"
For i =  2  To UBound(aOld)
  x = aOld(i) & "|"
  If Not str Like "*" & x & "*" Then str = str & x
Next i
aNew = Split(str, "|")
Range("B1").Resize(UBound(aNew) +  1 ) = Application.Transpose(aNew)
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36322600
Фотография qwrqwr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Честно скажу - читал топик "по-диагонали".
Вроде начинали с массив -> массив, а пришли к копированию уникальных значений из A1:A10000 в B1 ?
Тогда про этот вариант, вроде бы еще не говорили?
Код: plaintext
Range("A1:A10000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True
- не скажу за наилучшую скорость, но он точно читабельнее :)
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36322651
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
про этот вариант - быстро, стандартно, но почему не работает, если А1 пустая? И место ему расчистить нужно...
Я присматриваюсь, что можно в работе использовать, на разношёрстных данных - фильтр труднее прикрутить - следи за А1 всегда... да и на другой лист не выгрузишь.
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36322746
A-Nik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Hugo121... да и на другой лист не выгрузишь.
Кто сказал? Всё прекрасно выгружается

Код: plaintext
1.
2.
3.
4.
5.
Private Sub btnAdvFilter_Click()
Start! = Timer
Range("A1:A10000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets( 2 ).Range("B1"), Unique:=True
[CalckTime] = Timer - Start
End Sub
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36322778
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
qwrqwrЧестно скажу - читал топик "по-диагонали".
Вроде начинали с массив -> массив, а пришли к копированию уникальных значений из A1:A10000 в B1 ?
Тогда про этот вариант, вроде бы еще не говорили?
Код: plaintext
Range("A1:A10000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True
- не скажу за наилучшую скорость, но он точно читабельнее :)

Я первым делом подумал об этом, но речь действительно была о массивах. просто для удобства ввода и вывода используются ячейки.
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36322780
m
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
m
Гость
авторОчень интересное заключение.... A можно поинтересоваться почему так ?
А Вы попробуйте? Внесите 10000 значений в массив и в коллекцию ? Где быстрее?
Если не ошибаюсь, разница в скорости обработки существует из-за разницы в методах выделения оперативной памяти... Вот тоже разница описана немного:
http://findarticles.com/p/articles/mi_m0BLL/is_8_21/ai_n9537860/A collection differs from an array in that it isn't dimensioned, it is one-based, and it can hold multiple data types...There are two main reasons to choose a collection over an array. The first is that you can add as many items as you need without worrying about a limit. The second is data access speed. When finding an item in the collection, the program doesn't have to iterate through each item. If you use the optional keyword when adding items, the program can go directly to the desired item...
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36322826
Фотография qwrqwr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Deggasad
Я первым делом подумал об этом, но речь действительно была о массивах. просто для удобства ввода и вывода используются ячейки.:)
Ну началось-то все как:
ТСДопустим имеется массивОн (массив) ведь не из воздуха берется?
Я так понимаю - это ведь обычно данные либо из диапазона ячеек, либо Селект из внешнего источника.
В первом случае достаточно .AdvancedFilter в свободный столбец, а во втором просто DISTINCT в запросе указать.
А обработка некоего сферического массива в вакууме в VBA - только поэлементно, это да.
Единственное что есть для работы с массивом "разом" - текстовые функции Split/Join/Filter, но на текстовых операциях больше времени потеряешь.
Все исключительно IMHO.
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36322964
A-Nik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
mА Вы попробуйте? Внесите 10000 значений в массив и в коллекцию ? Где быстрее?А вы самы то пробовали ?

Вот, специально для вас тест:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
Sub btnArray_Collection_Copmare_Click()
Dim M, Arr, Col As New Collection, i&, Start!
M = [a1:a65536]
ReDim Arr( 1  To UBound(M))

Start = Timer
For i =  1  To UBound(M)
  Arr(i) = a
Next
[CalckTime] = Timer - Start

Start = Timer
For Each a In M
  Col.Add a
Next
[CalckTime].Offset( 1 ) = Timer - Start
End Sub
В столбец А занёс цифры от 1 до 65536

На таком диапазоне у меня в массив заносится в 5 раз быстрее, чем в коллекцию!
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36323000
A-Nik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Пардон, для варианта с массивом строку "Arr(i) = a" надо заменить на "Arr(i) = M(i, 1)".
Это я перешёл от For each a In M на For i = 1 to UBound(M) и забыл подправить.
В любом случае с массивом работает заметно быстрее!
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36323031
да, наверное Вы правы, просто когда пробовал сделать то, что Вам посоветовал, и разница была большая в пользу коллекции... может тогда что-то было по другому
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36323063
A-Nik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
неопытный m... разница была большая в пользу коллекции... смотря что а как делать
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36323066
A-Nik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
и как делать*
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36323147
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
qwrqwr[quot Deggasad]Он (массив) ведь не из воздуха берется?
Я так понимаю - это ведь обычно данные либо из диапазона ячеек, либо Селект из внешнего источника.
В первом случае достаточно .AdvancedFilter в свободный столбец, а во втором просто DISTINCT в запросе указать.
А обработка некоего сферического массива в вакууме в VBA - только поэлементно, это да.
Единственное что есть для работы с массивом "разом" - текстовые функции Split/Join/Filter, но на текстовых операциях больше времени потеряешь.
Все исключительно IMHO.
Да я ж тока ЗА. что обычно оно так, но вот жизнь научила не быть поспешным в суждениях :)
Применения всему находится и этим процедурам тоже может найтись.
Тут многие кричат, что эксель - это только чтобы табличку из БД выгрузить, как пример однозначности.
Однозначность хороша в других вопросах, например: НЕТ НАРКОТИКАМ И ОДНОПОЛОЙ ЛЮБВИ!
А мы тут как минимум мозг потренируем и то положительный момент :)
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36323173
A-Nik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
DeggasadОднозначность хороша в других вопросах, например: НЕТ НАРКОТИКАМ И ОДНОПОЛОЙ ЛЮБВИ!Так-так-так, по осторожнее с однозначными заявлениями... Некоторым парням посмотреть на лесби очень даже нравится.......
...
Рейтинг: 0 / 0
Удаление одинаковых записей из массива
    #36323177
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
A-NikНекоторым парням посмотреть на лесби очень даже нравится.......
Если бы они еще и детей стране рожали!!!
...
Рейтинг: 0 / 0
30 сообщений из 30, показаны все 2 страниц
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Удаление одинаковых записей из массива
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]