Страницы: 1
RSS
Макрос формирования коллекции только уникальных значений
 
Как переписать фрагмент макроса чтобы в коллекцию попадали только уникальные значения из столбца (а не все, как сейчас)
Код
On Error Resume Next
For Each myCell In myRange
    If CStr(myCell) Like "*/*" Or CStr(myCell) Like "*-*" Then
        myCollection.Add Replace(CStr(myCell), "/", "-")
    End If
Next myCell
On Error GoTo 0
 
Сергей М., зачем пустой файл?
возможно так
Код
On Error Resume Next
For Each myCell In myRange
   If CStr(myCell) Like "*/*" Or CStr(myCell) Like "*-*" Then
       on error resume next
       myCollection.Add Replace(CStr(myCell), "/", "-"), cstr(Replace(CStr(myCell), "/", "-"))
   End If
Next myCell
On Error GoTo 0
Изменено: Mershik - 29.11.2020 15:51:25
Не бойтесь совершенства. Вам его не достичь.
 
Сергей М., из названия темы текст перенесен в описание. Название темы изменено. Код в сообщении оформлен с помощью кнопки <...>
Правила форума здесь.
Запомните все это, пригодится, если опять будете создавать тему.
 
Я чтоб не делать лишней работы поступаю обычно так:
Код
    On Error Resume Next
    For Each myCell In myRange
        If CStr(myCell) Like "*/*" Or CStr(myCell) Like "*-*" Then
            t = Replace(CStr(myCell), "/", "-"): myCollection.Add t, t
        End If
    Next myCell
    On Error GoTo 0
 
vikttur, благодарю! Обязательно намотаю на ус
 
Hugo, благодарю за интерес к моему вопросу! Вы в ответе предложили исходный код.

Цитата
Mershik написал:  Сергей М. , зачем пустой файл?
Файл не пустой, модуль с макросом есть. К сожалению этот макрос не будет работать без папки с файлами.
И, спасибо! Ваше решение прекрасно работает! Тему можно закрывать, я доволен!
 
Цитата
Сергей М. написал:
Вы в ответе предложили исходный код.
- с такой внимательностью не взлетит...
 
:)  увидел! Спасибо!
 
Вариант через словарь.
Код
    Dim myDictionary As Object
    Set myDictionary = CreateObject("Scripting.Dictionary")
    On Error Resume Next
    For Each myCell In myRange
        If CStr(myCell) Like "*/*" Or CStr(myCell) Like "*-*" Then
            'myCollection.Add Replace(CStr(myCell), "/", "-")
            myDictionary.Item(Replace(CStr(myCell), "/", "-")) = 0
        End If
    Next myCell
    On Error GoTo 0
    
    Dim v As Variant
    For Each v In myDictionary
        myCollection.Add v
    Next
    Set myDictionary = Nothing
 
МатросНаЗебре, спасибо вам за помощь!
Страницы: 1
Наверх