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

Необходимо вывести в ListBox список уникальных значений из коллекции NoDupes, которая формируется по диапазону в книге Ехсеl. Если в диапазоне "Выбор" нет повторяющихся значений, то макрос работает, если есть повторения - то выдает ошибку.

Вот макрос. Что неправильно?

Sub removeDup()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection

On Error Resume Next
For Each Cell In Range("Выборка")

NoDupes.Add Cell.Value, CStr(Cell.Value)

Next Cell

On Error GoTo 0
For Each Item In NoDupes
Nachalo.ListBox1.AddItem Item
Next Item

Nachalo.Label1.Caption = _
"Кол-во элементов:" & NoDupes.Count

Nachalo.Show
End Sub

Спасибо
...
Рейтинг: 0 / 0
13.09.2011, 22:00
| Ответить | Цитировать | Написать  
Уникальные записи в коллекции
    #37439052
kuklp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
kuklp
Гость
gvozdev, если честно, то это свинство. Без примера выложили код. Гадайте, что у меня не так! Я с тем же успехом, даже не глянув, могу сказать: а у меня работает! Такой ответ устроит? Загляните в тему на дружественном форуме:
http://www.planetaexcel.ru/forum.php?forum_id=129
...
Рейтинг: 0 / 0
13.09.2011, 22:07
| Ответить | Цитировать | Написать  
Уникальные записи в коллекции
    #37439094
gvozdev
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
gvozdev
Гость
kuklp,

зато очень корректно отправлять на другой сайт.
Если хотите помочь помогайте, если непонятна формулировка вопроса - задайте свой.
...
Рейтинг: 0 / 0
13.09.2011, 22:40
| Ответить | Цитировать | Написать  
Уникальные записи в коллекции
    #37439121
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
gvozdevВот макрос. Что неправильно?
ну, во-первых, неправильно то, что вы не оформили код как положено, заставив уважаемых участников ломать глаза курсивом:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
Sub removeDup()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection

On Error Resume Next
For Each Cell In Range("Выборка")

  NoDupes.Add Cell.Value, CStr(Cell.Value)

Next Cell

On Error GoTo  0 
For Each Item In NoDupes
Nachalo.ListBox1.AddItem Item
Next Item
 
Nachalo.Label1.Caption = _
"Кол-во элементов:" & NoDupes.Count

Nachalo.Show
End Sub

Во-вторых, как, хоть и слишком резко (хотя сам требует обращения на Вы), предыдущий оратор подсказал, что неплохо бы выложить пример, чтобы не заставлять того, кто действительно хочет помочь, самому набивать тестовые данные.

В-третьих не указали ни строку, на которой возникает ошибка, ни сам текст ошибки, что начинает уже вызывать подозрение, что вам плохо хочется получить ответ...
...
Рейтинг: 0 / 0
13.09.2011, 23:02
| Ответить | Цитировать | Написать  
Уникальные записи в коллекции
    #37439126
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
Кстати, код рабочий.
...
Рейтинг: 0 / 0
13.09.2011, 23:06
| Ответить | Цитировать | Написать  
Уникальные записи в коллекции
    #37439133
kuklp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
kuklp
Гость
Shocker.ProВо-вторых, как, хоть и слишком резко (хотя сам требует обращения на Вы)Шокер, а я кому-то ТЫкнул? А в чем резкость? Назвал свинством, а не глупостью? Ну, мож ты и прав... Прошу прощения у автора.
...
Рейтинг: 0 / 0
13.09.2011, 23:16
| Ответить | Цитировать | Написать  
Уникальные записи в коллекции
    #37439135
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
 
kuklpШокер, а я кому-то ТЫкнул?
похоже, ТЫ/ВЫ у тебя это болезненная тема... ну да ладно, у каждого свои тараканы (и у меня тоже). Давай тока офф под спойлером...
...
Рейтинг: 0 / 0
13.09.2011, 23:20
| Ответить | Цитировать | Написать  
Уникальные записи в коллекции
    #37439398
gvozdev
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
gvozdev
Гость
Shocker.Pro,

Согласен, что задачу сформулировал нечетко.
"Выборка" - диапазон ячеек (А1:А100) с данными, среди которых есть повторения. Задача вывести в ListBox уникальные данные из этого диапазона.


Ошибка выскакивает на строке NoDupes.Add Cell.Value, CStr(Cell.Value) , после чтения неуникальной записи в данном диапазоне, хотя поставил On Error Resume Next
...
Рейтинг: 0 / 0
14.09.2011, 09:44
| Ответить | Цитировать | Написать  
Уникальные записи в коллекции
    #37440971
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AndreTM
Участник
gvozdev,
Код: plaintext
1.
2.
3.
On Error Resume Next
For Each Cell In Range("Выборка")
    NoDupes.Add Cell.Value, CStr(Cell.Value)
Next Cell
будет спотыкаться на каждом подряд идущем дубле Cell.Value, отсюда и ошибка.
Вообще, если вы хотите получить гарантированно уникальные значения из выборки, то путь для вас - либо отсортировать выборку, а потом анализировать её последовательно, добавляя неповторяющиеся значения; либо анализировать на каждой итерации заполненные значения. И никаких FOR EACH, ибо как там работают оптимизаторы - ведомо лишь МС, - поэтому только реальный перебор строк счетчиком в диапазоне...
Кроме того, не забывайте, что лист/комбобокс можно заполнить не только с помощью .Add, и и прямо из массива переменных памяти, с которым вы можете работать до этого.

С другой стороны (судя по названию "Выборка") - вы ЭТО уже откуда-то отобрали; так кто вам мешал избавиться от дубликатов еще на этапе отбора?
...
Рейтинг: 0 / 0
15.09.2011, 01:02
| Ответить | Цитировать | Написать  
Уникальные записи в коллекции
    #37440984
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
AndreTM,

Да не, должно работать. И работает - я проверял этот код, и писал выше, что он рабочий.
Ошибка где-то в стеке On Error, скорее всего на обрамлении этой процедуры, которое автор не приводит.

Но автор по непонятным причинам категорически не хочет выложить тестовый пример
...
Рейтинг: 0 / 0
15.09.2011, 01:53
| Ответить | Цитировать | Написать  
Уникальные записи в коллекции
    #37441038
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AndreTM
Участник
Shocker.Pro,

Как вариант - ошибка именно в стеке.
Если ТС злоупотребляет конструкциями ON ERROR на каждом шаге - я даже не удивлюсь.
Ибо глубина стека возвратов не бесконечна...
...
Рейтинг: 0 / 0
15.09.2011, 07:22
| Ответить | Цитировать | Написать  
Уникальные записи в коллекции
    #37441104
gvozdev
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
gvozdev
Гость
Shocker.Pro,

Вы правы. Макрос работает, но почему-то не на всех машинах. на работе Еxcel 2007 - работает, дома в 2003 -нет.
...
Рейтинг: 0 / 0
15.09.2011, 09:07
| Ответить | Цитировать | Написать  
Уникальные записи в коллекции
    #37441413
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
gvozdev,

А как запустить-то? У меня открывается форма размером больше чем на экран - ужас.
...
Рейтинг: 0 / 0
15.09.2011, 11:28
| Ответить | Цитировать | Написать  
Уникальные записи в коллекции
    #37441486
kuklp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
kuklp
Гость
Пара вариантов, с сортировкой и без. Проверил на 3, 7 и 10 Экселях. С сортировкой взято по приведенной ранее ссылке. Только она почему-то неверно скопировалась:-(
...
Рейтинг: 0 / 0
15.09.2011, 11:52
| Ответить | Цитировать | Написать  
Уникальные записи в коллекции
    #37441549
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
kuklp,

Я не получил ответ на вопрос, как запустить
Нажатие на кнопки Go ошибок не выдает.

Можно урезать тестовый файл до единственного нерабочего фрагмента, а не выдавать мне форму больше, чем мой экран, которую невозможно закрыть крестиком с неизвестной надобностью.
...
Рейтинг: 0 / 0
15.09.2011, 12:14
| Ответить | Цитировать | Написать  
Уникальные записи в коллекции
    #37441557
kuklp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
kuklp
Гость
Shocker.Pro, согласен, форма - ни в какие рамки. Уменьшил форму, см. файл.
...
Рейтинг: 0 / 0
15.09.2011, 12:23
| Ответить | Цитировать | Написать  
Уникальные записи в коллекции
    #37441840
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
И в очередной раз я пытаюсь выяснить - что нужно сделать, чтобы увидеть глюк????????

Мы так до конца сезона будем переписываться
...
Рейтинг: 0 / 0
15.09.2011, 14:51
| Ответить | Цитировать | Написать  
Уникальные записи в коллекции
    #37443131
gvozdev
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
gvozdev
Гость
Shocker.Pro,

Прошу еще раз прощение за оформление. Уважаемый Kuklp исправил файл за меня. На рабочем компе макрос работает, дома нет.
Видно где-то проблема в программе. Всем большое спасибо!
...
Рейтинг: 0 / 0
16.09.2011, 11:28
| Ответить | Цитировать | Написать  
Уникальные записи в коллекции
    #37444774
Фотография The_Prist
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
The_Prist
Участник
gvozdev, я не настаиваю, но все-таки лучше давать переменным имена, не совпадающие с именами уже зарезервированными в VBA(item,cell). И неплохо бы все переменные объявлять.
Проверил в обеих версиях Excel: все работает.

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
Sub removeDup()
    Dim AllCells As Range, rCell As Range, iItem
    Dim Koll_shifr As New Collection
    Dim Koll_kod As New Collection

    On Error Resume Next
    For Each rCell In Range("Vubor_po_shifry")
        Koll_shifr.Add rCell.Value, CStr(rCell.Value)
        Koll_kod.Add rCell.Offset( 0 ,  1 ).Value, CStr(rCell.Offset( 0 ,  1 ).Value)
    Next rCell

    On Error GoTo  0 
    For Each iItem In Koll_shifr
        Nachalo.ListBox1.AddItem iItem
    Next iItem

    For Each iItem In Koll_kod
        Nachalo.ListBox1.AddItem iItem
    Next iItem

    Nachalo.Label2.Caption = _
    "Количество документов: " & Koll_shifr.Count
    Nachalo.Show
End Sub
...
Рейтинг: 0 / 0
17.09.2011, 15:08
| Ответить | Цитировать | Написать  
Уникальные записи в коллекции
    #37446794
EducatedFool
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
EducatedFool
Гость
А почему не воспользоваться готовой функцией?
http://excelvba.ru/code/UniqueValuesFromArray

Код: plaintext
ListBox1.List = UniqueValuesFromArray(Range("Выборка").value,  1 )
...
Рейтинг: 0 / 0
19.09.2011, 18:21
| Ответить | Цитировать | Написать  
20 сообщений из 20, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Уникальные записи в коллекции
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=61&msg=37439121&tid=2176485]:
 0ms
get settings:
 10ms
get forum list:
 18ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 183ms
get topic data:
 10ms
get forum data:
 3ms
get page messages:
 75ms
get tp. blocked users:
 2ms
others: 240ms
total:  547ms
созд. / загр.: 547ms
x
x
Закрыть


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