ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / поиск уникальных значений
25 сообщений из 26, страница 1 из 2
  1  все
поиск уникальных значений
    #36241921
Gus_Hidding
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Gus_Hidding
Гость
Доброго дня.
помогите правильно реализовать задачу.

есть такие данные:

103
101
101
102
103
104
104

при встрече первого уникального значения, напротив него надо поставить "1", примерно так:

103 1
101 1
101
102 1
103
104 1
104


вот это конечно не вариант:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
Sub Макрос1()
Dim i, j As Integer

For j =  1  To  4 

For i =  1  To  7 
If Cells(j,  4 ) = Cells(i,  1 ) Then
Cells(i,  2 ) = "1"
GoTo  1 
End If

Next i
 1 
Next j

End Sub

у меня около 40к значений, считает час. как сделать по-граммотному?
...
Рейтинг: 0 / 0
09.10.2009, 13:13
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36241935
MaximuS_G
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MaximuS_G
Участник
Как бы сделал я:
Обязательно ли делать программно ?
Если Вы данные вставите в Аксесс, то запросом в одну строчку Вы найдете то что Вам нужно за 10 секунд :). Реализуемо ?
...
Рейтинг: 0 / 0
09.10.2009, 13:17
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36241975
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Ну и к тому же данные можно не вставлять в Access (Copy-Paste или Import), а сделать их источником данных (Link Tables). Так их всегда легко подменить на другие - кладём другой файл с таким же названием -> анализируем другие данные (подразумеваются однотипные файлы, например отчёт за другой период).
...
Рейтинг: 0 / 0
09.10.2009, 13:27
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36242059
MaximuS_G
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MaximuS_G
Участник
Ну или сегодняшняя моя инновация (для меня, не был уверен что получится):
Sub VotEtoDa()
Dim rs As DAO.Recordset
Dim dbe As New DAO.DBEngine
Dim mdb As Database
Dim sql As String
Dim mPath As String

mPath = ActiveWorkbook.FullName

Set mdb = dbe.OpenDatabase(mPath, False, False, "Excel 8.0;")
Set rs = mdb.OpenRecordset("Select Distinct F1 From my")
rs.MoveLast
rs.MoveFirst

For i = 1 To rs.RecordCount
Cells(i, 5).Value = rs.Fields("F1").Value
rs.MoveNext
Next i

End Sub
Только нужно сделать 23 действия:
Подключить библиотеку - Microsoft DAO
И назвать Ваш диапазон данных как-нибудь... Ну у меня он назван "my"
...
Рейтинг: 0 / 0
09.10.2009, 13:55
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36242097
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Что-то у меня ругается (Defined Error) на Set rs = mdb.OpenRecordset("Select Distinct F1 From my")
...
Рейтинг: 0 / 0
09.10.2009, 14:05
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36242114
Gus_Hidding
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Gus_Hidding
Гость
Hugo121, DAO подключил?:)
_
парни спасибо за ответы, но в Эксессе я бы сам сделал, на работе нет прав установить, а начальника не считает нужным поставить мне его.

надо в Экселе как-то любыми путями...
...
Рейтинг: 0 / 0
09.10.2009, 14:08
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36242162
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
И DAO, и Access 9.0...
Я делал такое в Экселе.
Вот почти готово, внизу лишнюю 1 ставит на первую пустую строку, некогда сейчас шлифовать:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
Sub unik()

ReDim MyArray( 0 )
rcnt = ActiveSheet.UsedRange.Rows.Count 'scitaem cislo obrabativaemih jaceek
MyArray( 0 ) = Cells( 1 ,  1 ).Value 'obrabativaem 1 kolonku
Cells( 1 ,  2 ).Value =  1 
For i =  1  To rcnt 'nacinajem s pervoj jaceiki
  For j =  0  To UBound(MyArray())
        If MyArray(j) = UCase(Cells(i,  1 ).Value) Then flag =  1  ' takoe znacenie uze estj
  Next
    If flag =  0  Then
    ReDim Preserve MyArray(UBound(MyArray()) +  1 )
    MyArray(UBound(MyArray())) = UCase(Cells(i,  1 ).Value) ' zanosim v massiv
    Cells(i,  2 ).Value =  1 
    End If
flag =  0 
Next
End Sub
...
Рейтинг: 0 / 0
09.10.2009, 14:19
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36242195
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Да, UCase там остались с предыдущей версии, я там строки сравнивал, невзирая на регистр букв. В данном случае UCase не нужен, но и не мешает.
...
Рейтинг: 0 / 0
09.10.2009, 14:26
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36242197
Gus_Hidding
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Gus_Hidding
Гость
Hugo121, спасибо друг!
с меня завтра победа над немцами!
...
Рейтинг: 0 / 0
09.10.2009, 14:26
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36242221
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Только есть один недочёт (сейчас заметил в свете новых знаний) - код рассчитан, что UsedRange начинается с первой строки. Если не так, надо шлифануть.
...
Рейтинг: 0 / 0
09.10.2009, 14:32
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36242336
MaximuS_G
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MaximuS_G
Участник
Hugo121Что-то у меня ругается (Defined Error) на Set rs = mdb.OpenRecordset("Select Distinct F1 From my")
Создали именованный диапазон ?
...
Рейтинг: 0 / 0
09.10.2009, 15:06
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36242373
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Всю колонку целиком выделил. Сечас попробовал только на части колонки - ничего не изменилось. Может ещё какая библиотека нужна? У меня сейчас такие:
...
Рейтинг: 0 / 0
09.10.2009, 15:16
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36242501
MaximuS_G
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MaximuS_G
Участник
Hugo121Может ещё какая библиотека нужна?
Да, нет, библиотеки вроде все... Еще раз к именнованому диапазону:
Если Вы нажмете Вставка-Имя-Вставить... получите где то следующие: my=Лист1!R1C1:R7C1 так ?

Еще только что придумал код :)... Действителен только для чисел. Ну в данном случае наверное идеален...
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
Sub Bistree()
Dim arr() As Integer
Dim t

't = Timer

For i =  1  To  40000 
ReDim Preserve arr( 1  To тут максимальное значение в колонке)
'MsgBox UBound(arr)
If Cells(i,  1 ).Value <> arr(Cells(i,  1 ).Value) Then
Cells(i,  2 ).Value =  1 
arr(Cells(i,  1 ).Value) = Cells(i,  1 ).Value
End If
Next i

'MsgBox Timer - t

End Sub

В диапазоне 100-200 на 40000 ячеек выполнение 1,2 секунды.
Ваш код (Hugo121) - 13,2 секунды.
...
Рейтинг: 0 / 0
09.10.2009, 15:46
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36242507
MaximuS_G
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MaximuS_G
Участник
ReDim Preserve arr(1 To тут максимальное значение в колонке) можна вынести из цикла, а лучше вообще при объявление указать диапазон
...
Рейтинг: 0 / 0
09.10.2009, 15:47
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36242587
MaximuS_G
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MaximuS_G
Участник
И еще чуть изменив
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
...
't = Timer
ReDim Preserve arr( 1  To  200 )

For i =  1  To  40000 
'MsgBox UBound(arr)
If arr(Cells(i,  1 ).Value) =  0  Then
...

получим 0.62 секунды
...
Рейтинг: 0 / 0
09.10.2009, 16:13
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36242707
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Зато Ваш код дробями не работает :)
Ещё вопрос - как таймер заставить маленькое время показывать (0,62)? Что-то у меня 0 показывает...
...
Рейтинг: 0 / 0
09.10.2009, 16:52
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36242737
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Я понял, почему с DAO не работало - надо было файл сохранить :) А я на свежем пробовал, несохранённом ещё.
...
Рейтинг: 0 / 0
09.10.2009, 17:01
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36242742
MaximuS_G
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MaximuS_G
Участник
Hugo121Зато Ваш код дробями не работает :)
Ещё вопрос - как таймер заставить маленькое время показывать (0,62)? Что-то у меня 0 показывает...
Да, это правда, и еще с буквами тоже :)...
Про таймер даже не знаю, почему так может быть... Всегда показывает целые числа ? Даже при выполнении Вашего макро, или не показывает меньше единицы, тоесть сразу 0 ?
Может в Вас комп быстрее чем у меня, и код за 0 секунд выполняется :))

С АДО разобрались ?
...
Рейтинг: 0 / 0
09.10.2009, 17:02
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36242792
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Нет, дробные тоже показывает, если искусственно тормознуть. Машина не очень шустрая, пень 2,8Ггц
С ДАО заработало, коду ведь mPath = ActiveWorkbook.FullName подавай, а где его взять, если файл ещё не сохраняли?
В общем, интересный вариант с ДАО, не пользовал такое, возьму на заметку, спасибо. Только не поясните, что означает F1 в коде?
Код: plaintext
Set rs = mdb.OpenRecordset("Select Distinct F1 From my"
...
Рейтинг: 0 / 0
09.10.2009, 17:18
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36242801
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Да, и на мой код тоже много раз 0, а затем как-то 0,015625
...
Рейтинг: 0 / 0
09.10.2009, 17:21
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36242903
MaximuS_G
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MaximuS_G
Участник
Hugo121В общем, интересный вариант с ДАО, не пользовал такое, возьму на заметку, спасибо. Только не поясните, что означает F1 в коде?
Set rs = mdb.OpenRecordset("Select Distinct F1 From my")
F1 означает названия поля. Его система автоматически присваивает.
В АДО можна указывать, использовать первую строку как название столбцов или нет.
Наверное и в ДАО можна, но я не знаю как :)

Да, и на мой код тоже много раз 0, а затем как-то 0,015625
Да, эксель мочит... У меня тоже вот код глючит, сам себе прокручивает 2 раза без каких либо циклов , а если через F8 то все нормально... Видимо есть какие-то нюансы.
...
Рейтинг: 0 / 0
09.10.2009, 17:51
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36243599
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
Не пойму куда с форума подевались люди, которые альтернативное решение формулами предлагали? ведь многие вещи не требуют сложных программных решений, достаточно знать элементарные формулы
...
Рейтинг: 0 / 0
10.10.2009, 11:04
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36243692
MaximuS_G
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MaximuS_G
Участник
DeggasadНе пойму куда с форума подевались люди, которые альтернативное решение формулами предлагали? ведь многие вещи не требуют сложных программных решений, достаточно знать элементарные формулы
ТС не спрашивал формулу, ее и не предлагают :)... А вообще, это правильно, что то что можна сделать формулой, лучше делать формулой, чем макросом... Так что Вы предлагайте, а Мы (Я) будем учиться :)....
...
Рейтинг: 0 / 0
10.10.2009, 14:47
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36243764
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Мне так удобнее сделать один раз макрос, чем каждый раз в файле формулы сочинять/протягивать.
Да и сформулами затем осторожно надо обращаться, ни скопировать, ни перенести данные без опаски нельзя...
Ведь обычно работы однотипны - вот например эта задача чувствую скоро у меня будет актуальна каждую неделю, и наверное в разных по происхождению и расположению колонок файлах. Поэтому дополнил макрос для универсальности:

Код: 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.
Sub unique()
target = (InputBox("What Column Inspected? (Number)", target,  1 ,  1500 ,  2000 )) *  1 
uniq = (InputBox("What Column For Mark? (Number)", uniq,  2 ,  1500 ,  2000 )) *  1 

ReDim MyArray( 0 )
first = ActiveSheet.UsedRange.Row
rcnt = ActiveSheet.UsedRange.Rows.Count 'scitaem cislo obrabativaemih jaceek
MyArray( 0 ) = Cells(first, target).Value 'obrabativaem kolonku
Cells(first,  2 ).Value = "unique"
For i = first To first + rcnt -  1  'nacinajem s pervoj jaceiki diapazona
  For j =  0  To UBound(MyArray())
        If MyArray(j) = UCase(Cells(i, target).Value) Then flag =  1  ' takoe znacenie uze estj
  Next
    If flag =  0  Then
    ReDim Preserve MyArray(UBound(MyArray()) +  1 )
    MyArray(UBound(MyArray())) = UCase(Cells(i, target).Value) ' zanosim v massiv
    Cells(i, uniq).Value = "unique"
    End If
flag =  0 
Next

End Sub

Sub uniqueA()
target = InputBox("What Column Inspected? (Letter)", "target", "A",  1500 ,  2000 )
uniq = InputBox("What Column For Mark? (Letter)", "uniq", "B",  1500 ,  2000 )

ReDim MyArray( 0 )
first = ActiveSheet.UsedRange.Row
rcnt = ActiveSheet.UsedRange.Rows.Count 'scitaem cislo obrabativaemih jaceek
MyArray( 0 ) = Cells(first, target).Value 'obrabativaem kolonku
Cells(first,  2 ).Value = "unique"
For i = first To first + rcnt -  1  'nacinajem s pervoj jaceiki diapazona
  For j =  0  To UBound(MyArray())
        If MyArray(j) = UCase(Cells(i, target).Value) Then flag =  1  ' takoe znacenie uze estj
  Next
    If flag =  0  Then
    ReDim Preserve MyArray(UBound(MyArray()) +  1 )
    MyArray(UBound(MyArray())) = UCase(Cells(i, target).Value) ' zanosim v massiv
    Cells(i, uniq).Value = "unique"
    End If
flag =  0 
Next

End Sub

Тут два варианта - под цифровое обозначение колонки и под буквенное. Какую колонку просматривать и куда ставить пометку, спрашивается в InputBox-е. И пусть оно работает медленнее, зато универсально под любую смесь данных (регистр букв игнорирует).
Работает с UsedRange не обязательно с первой ячейки, лишние пометки внизу не ставит (шлифанул :) )
...
Рейтинг: 0 / 0
10.10.2009, 17:21
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36244036
ZVI
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ZVI
Участник
Можно собъединить VBA и то, что могут формулы ячеек:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
Sub IsUnique(Rng As Range)
  With Rng.Offset(,  1 )
    .FormulaR1C1 = "=IF(MATCH(RC[-1],R1C1:RC[-1],0)=ROW(),1,"""")"
    .Value = .Value
  End With
End Sub

Sub test()
  IsUnique Range("A1:A7")
End Sub
...
Рейтинг: 0 / 0
10.10.2009, 23:13
| Ответить | Цитировать | Написать  
25 сообщений из 26, страница 1 из 2
  1  все
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / поиск уникальных значений
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=61&msg=36242792&tid=2178979]:
 0ms
get settings:
 10ms
get forum list:
 19ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 20ms
get topic data:
 13ms
get forum data:
 3ms
get page messages:
 58ms
get tp. blocked users:
 1ms
others: 243ms
total:  373ms
созд. / загр.: 373ms
x
x
Закрыть


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