Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / поиск уникальных значений / 25 сообщений из 26, страница 1 из 2
  1  все
09.10.2009, 13:13:20
    #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:17:00
    #36241935
MaximuS_G
MaximuS_G
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск уникальных значений
Как бы сделал я:
Обязательно ли делать программно ?
Если Вы данные вставите в Аксесс, то запросом в одну строчку Вы найдете то что Вам нужно за 10 секунд :). Реализуемо ?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.10.2009, 13:27:38
    #36241975
Hugo121
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск уникальных значений
Ну и к тому же данные можно не вставлять в Access (Copy-Paste или Import), а сделать их источником данных (Link Tables). Так их всегда легко подменить на другие - кладём другой файл с таким же названием -> анализируем другие данные (подразумеваются однотипные файлы, например отчёт за другой период).
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.10.2009, 13:55:52
    #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, 14:05:18
    #36242097
Hugo121
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск уникальных значений
Что-то у меня ругается (Defined Error) на Set rs = mdb.OpenRecordset("Select Distinct F1 From my")
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.10.2009, 14:08:42
    #36242114
Gus_Hidding
Gus_Hidding
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск уникальных значений
Hugo121, DAO подключил?:)
_
парни спасибо за ответы, но в Эксессе я бы сам сделал, на работе нет прав установить, а начальника не считает нужным поставить мне его.

надо в Экселе как-то любыми путями...
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.10.2009, 14:19:17
    #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:26:28
    #36242195
Hugo121
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск уникальных значений
Да, UCase там остались с предыдущей версии, я там строки сравнивал, невзирая на регистр букв. В данном случае UCase не нужен, но и не мешает.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.10.2009, 14:26:59
    #36242197
Gus_Hidding
Gus_Hidding
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск уникальных значений
Hugo121, спасибо друг!
с меня завтра победа над немцами!
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.10.2009, 14:32:14
    #36242221
Hugo121
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск уникальных значений
Только есть один недочёт (сейчас заметил в свете новых знаний) - код рассчитан, что UsedRange начинается с первой строки. Если не так, надо шлифануть.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.10.2009, 15:06:56
    #36242336
MaximuS_G
MaximuS_G
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск уникальных значений
Hugo121Что-то у меня ругается (Defined Error) на Set rs = mdb.OpenRecordset("Select Distinct F1 From my")
Создали именованный диапазон ?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.10.2009, 15:16:47
    #36242373
Hugo121
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск уникальных значений
Всю колонку целиком выделил. Сечас попробовал только на части колонки - ничего не изменилось. Может ещё какая библиотека нужна? У меня сейчас такие:
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.10.2009, 15:46:27
    #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:47:34
    #36242507
MaximuS_G
MaximuS_G
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск уникальных значений
ReDim Preserve arr(1 To тут максимальное значение в колонке) можна вынести из цикла, а лучше вообще при объявление указать диапазон
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.10.2009, 16:13:17
    #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:52:33
    #36242707
Hugo121
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск уникальных значений
Зато Ваш код дробями не работает :)
Ещё вопрос - как таймер заставить маленькое время показывать (0,62)? Что-то у меня 0 показывает...
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.10.2009, 17:01:35
    #36242737
Hugo121
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск уникальных значений
Я понял, почему с DAO не работало - надо было файл сохранить :) А я на свежем пробовал, несохранённом ещё.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.10.2009, 17:02:56
    #36242742
MaximuS_G
MaximuS_G
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск уникальных значений
Hugo121Зато Ваш код дробями не работает :)
Ещё вопрос - как таймер заставить маленькое время показывать (0,62)? Что-то у меня 0 показывает...
Да, это правда, и еще с буквами тоже :)...
Про таймер даже не знаю, почему так может быть... Всегда показывает целые числа ? Даже при выполнении Вашего макро, или не показывает меньше единицы, тоесть сразу 0 ?
Может в Вас комп быстрее чем у меня, и код за 0 секунд выполняется :))

С АДО разобрались ?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.10.2009, 17:18:13
    #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:21:15
    #36242801
Hugo121
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск уникальных значений
Да, и на мой код тоже много раз 0, а затем как-то 0,015625
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.10.2009, 17:51:03
    #36242903
MaximuS_G
MaximuS_G
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск уникальных значений
Hugo121В общем, интересный вариант с ДАО, не пользовал такое, возьму на заметку, спасибо. Только не поясните, что означает F1 в коде?
Set rs = mdb.OpenRecordset("Select Distinct F1 From my")
F1 означает названия поля. Его система автоматически присваивает.
В АДО можна указывать, использовать первую строку как название столбцов или нет.
Наверное и в ДАО можна, но я не знаю как :)

Да, и на мой код тоже много раз 0, а затем как-то 0,015625
Да, эксель мочит... У меня тоже вот код глючит, сам себе прокручивает 2 раза без каких либо циклов , а если через F8 то все нормально... Видимо есть какие-то нюансы.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.10.2009, 11:04:36
    #36243599
Deggasad
Deggasad
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск уникальных значений
Не пойму куда с форума подевались люди, которые альтернативное решение формулами предлагали? ведь многие вещи не требуют сложных программных решений, достаточно знать элементарные формулы
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.10.2009, 14:47:56
    #36243692
MaximuS_G
MaximuS_G
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск уникальных значений
DeggasadНе пойму куда с форума подевались люди, которые альтернативное решение формулами предлагали? ведь многие вещи не требуют сложных программных решений, достаточно знать элементарные формулы
ТС не спрашивал формулу, ее и не предлагают :)... А вообще, это правильно, что то что можна сделать формулой, лучше делать формулой, чем макросом... Так что Вы предлагайте, а Мы (Я) будем учиться :)....
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.10.2009, 17:21:18
    #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, 23:13:31
    #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
| Ответить | Цитировать | Написать  
  1  все
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / поиск уникальных значений / 25 сообщений из 26, страница 1 из 2
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение  
Полит. конфиден.  
созд. / загр.: 508ms
Закрыть
start [/forum/topic.php?fid=61&mobile=1&tid=2178979]:
 0ms
get settings:
 8ms
get forum list:
 16ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 188ms
get topic data:
 13ms
get forum data:
 3ms
get page messages:
 77ms
get tp. blocked users:
 1ms
others: 194ms
total:  508ms
x
x
Закрыть


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