Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Удаление одинаковых записей из массива / 25 сообщений из 30, страница 1 из 2
17.11.2009, 14:18
    #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
17.11.2009, 14:43
    #36314942
m
m
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Удаление одинаковых записей из массива
можно переносить по одному значению из старого в новый массив, при этом проверять нет ли такого значения в новом.
...
Рейтинг: 0 / 0
17.11.2009, 14:47
    #36314950
andMegaM
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Удаление одинаковых записей из массива
А как сделать поиск значения в массиве?
...
Рейтинг: 0 / 0
17.11.2009, 15:18
    #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
19.11.2009, 11:27
    #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
19.11.2009, 11:36
    #36319211
m
m
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Удаление одинаковых записей из массива
A-NikMaximuS_G, круто, конечно, но лучше, всё таки, так:
Да, у Вас намного быстрее и интереснее, но не сказал бы что правильнее. Мне кажется использование On Error Resume Next не совсем правильно. Всего лишь мое мнение :)
...
Рейтинг: 0 / 0
19.11.2009, 13:26
    #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
19.11.2009, 16:53
    #36320341
A-Nik
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Удаление одинаковых записей из массива
Вот ещё вариант ...
Ощутите разницу
...
Рейтинг: 0 / 0
20.11.2009, 00:30
    #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
20.11.2009, 09:37
    #36321494
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Удаление одинаковых записей из массива
Код Deggassad единственный игнорирует пробелы - как оказалось, не совсем - если первая ячейка диапазона пустая, то она заносится в массив пустой. Но это конечно можно обойти дополнительной проверкой перед занесением в str.
...
Рейтинг: 0 / 0
20.11.2009, 10:49
    #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
20.11.2009, 10:57
    #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
20.11.2009, 11:15
    #36321758
m
m
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Удаление одинаковых записей из массива
Зато он оригинальный :)...
Код от A-Nik однозначно будет быстрее, так как он использует коллекции, а коллекции в разы быстрее обрабатываются чем массивы типа Array.
...
Рейтинг: 0 / 0
20.11.2009, 11:23
    #36321773
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Удаление одинаковых записей из массива
Да я тоже только учусь :) Понимаю, что не быстрый вывод, ну так вот Вы показали, как лучше, да и тема развилась в хороший учебный пример :)
Мне бы год назад это почитать, когда я только подступался к массивам...
...
Рейтинг: 0 / 0
20.11.2009, 11:33
    #36321795
A-Nik
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Удаление одинаковых записей из массива
mКод от A-Nik однозначно будет быстрее, так как он использует коллекции, а коллекции в разы быстрее обрабатываются чем массивы типа Array.
Очень интересное заключение....
A можно поинтересоваться почему так ?
...
Рейтинг: 0 / 0
20.11.2009, 12:09
    #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
20.11.2009, 15:29
    #36322600
qwrqwr
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Удаление одинаковых записей из массива
Честно скажу - читал топик "по-диагонали".
Вроде начинали с массив -> массив, а пришли к копированию уникальных значений из A1:A10000 в B1 ?
Тогда про этот вариант, вроде бы еще не говорили?
Код: plaintext
Range("A1:A10000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True
- не скажу за наилучшую скорость, но он точно читабельнее :)
...
Рейтинг: 0 / 0
20.11.2009, 15:43
    #36322651
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Удаление одинаковых записей из массива
про этот вариант - быстро, стандартно, но почему не работает, если А1 пустая? И место ему расчистить нужно...
Я присматриваюсь, что можно в работе использовать, на разношёрстных данных - фильтр труднее прикрутить - следи за А1 всегда... да и на другой лист не выгрузишь.
...
Рейтинг: 0 / 0
20.11.2009, 16:03
    #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
20.11.2009, 16:11
    #36322778
Deggasad
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Удаление одинаковых записей из массива
qwrqwrЧестно скажу - читал топик "по-диагонали".
Вроде начинали с массив -> массив, а пришли к копированию уникальных значений из A1:A10000 в B1 ?
Тогда про этот вариант, вроде бы еще не говорили?
Код: plaintext
Range("A1:A10000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True
- не скажу за наилучшую скорость, но он точно читабельнее :)

Я первым делом подумал об этом, но речь действительно была о массивах. просто для удобства ввода и вывода используются ячейки.
...
Рейтинг: 0 / 0
20.11.2009, 16:11
    #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
20.11.2009, 16:22
    #36322826
qwrqwr
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Удаление одинаковых записей из массива
Deggasad
Я первым делом подумал об этом, но речь действительно была о массивах. просто для удобства ввода и вывода используются ячейки.:)
Ну началось-то все как:
ТСДопустим имеется массивОн (массив) ведь не из воздуха берется?
Я так понимаю - это ведь обычно данные либо из диапазона ячеек, либо Селект из внешнего источника.
В первом случае достаточно .AdvancedFilter в свободный столбец, а во втором просто DISTINCT в запросе указать.
А обработка некоего сферического массива в вакууме в VBA - только поэлементно, это да.
Единственное что есть для работы с массивом "разом" - текстовые функции Split/Join/Filter, но на текстовых операциях больше времени потеряешь.
Все исключительно IMHO.
...
Рейтинг: 0 / 0
20.11.2009, 16:56
    #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
20.11.2009, 17:05
    #36323000
A-Nik
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Удаление одинаковых записей из массива
Пардон, для варианта с массивом строку "Arr(i) = a" надо заменить на "Arr(i) = M(i, 1)".
Это я перешёл от For each a In M на For i = 1 to UBound(M) и забыл подправить.
В любом случае с массивом работает заметно быстрее!
...
Рейтинг: 0 / 0
20.11.2009, 17:11
    #36323031
Удаление одинаковых записей из массива
да, наверное Вы правы, просто когда пробовал сделать то, что Вам посоветовал, и разница была большая в пользу коллекции... может тогда что-то было по другому
...
Рейтинг: 0 / 0
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Удаление одинаковых записей из массива / 25 сообщений из 30, страница 1 из 2
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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