Независимая копия объекта Scripting.Dictionary

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Независимая копия объекта Scripting.Dictionary (Макросы/Sub)

sboy

Дата: Вторник, 16.10.2018, 15:32 | Сообщение № 1

Группа: Друзья

Ранг: Участник клуба

Сообщений: 2566

Репутация: 724 ±

Замечаний: 0% ±

Excel 2010

Доброго дня всем.
Подскажите как правильно делать копию словарика. Я заполняю словарик, делаю копию. В копии удаляю ненужные мне элементы. Но они и в оригинальном словаре тоже удаляются. А мне он нужен целым и невредимым)
Пример вот такой написал
[vba]

Код

Sub qqq()
    Set dic1 = CreateObject("Scripting.Dictionary")
    arr = [a1:a30].Value
    For i = 1 To UBound(arr)
        dic1.Item(arr(i, 1)) = dic1.Item(arr(i, 1)) + 1
    Next
    Set dic2 = CreateObject("Scripting.Dictionary")
    Set dic2 = dic1
    qqqq 3, dic2
End Sub

Function qqqq(q As Integer, ByVal dic As Object)
    For Each k In dic.keys
        If dic.Item(k) <> q Then dic.Remove (k)
    Next
    If dic.Count > 0 Then
        ks = dic.keys
        qqqq = ks(0)
    End If
End Function

[/vba]

К сообщению приложен файл: 3961629.xlsm (16.0 Kb)

Яндекс: 410016850021169

Ответить

Апострофф

Дата: Вторник, 16.10.2018, 16:33 | Сообщение № 2

Группа: Проверенные

Ранг: Обитатель

Сообщений: 445

Репутация: 123 ±

Замечаний: 0% ±

Excel 1997

Привет!
Наверно потому, что

Цитата

Set dic2 = dic1

т.е. это один и тот же объект
[vba]

Код

Sub qqq()
    Set dic1 = CreateObject("Scripting.Dictionary")
    Set dic2 = CreateObject("Scripting.Dictionary")
   arr = [a1:a30].Value
    For i = 1 To UBound(arr)
        dic1.Item(arr(i, 1)) = dic1.Item(arr(i, 1)) + 1
        dic2.Item(arr(i, 1)) = dic2.Item(arr(i, 1)) + 1
    Next
'    Set dic2 = dic1
    qqqq 3, dic2
End Sub

[/vba]

Ответить

_Boroda_

Дата: Вторник, 16.10.2018, 16:46 | Сообщение № 3

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16672

Репутация: 6479 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

Или после создания первого словаря по нему создайте второй
[vba]

Код

Sub qqq()
    Dim dic1 As Object
    Dim dic2 As Object
    Set dic1 = CreateObject("Scripting.Dictionary")
    Set dic2 = CreateObject("Scripting.Dictionary")
    arr = [a1:a30].Value
    For i = 1 To UBound(arr)
        dic1.Item(arr(i, 1)) = dic1.Item(arr(i, 1)) + 1
    Next
    a = dic1.keys
    b = dic1.items
    For i = 0 To UBound(a)
        dic2.Add a(i), b(i)
    Next
    For Each k In dic2.keys
        If dic2.Item(k) <> q Then dic2.Remove (k)
    Next
End Sub

[/vba]

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

sboy

Дата: Вторник, 16.10.2018, 16:53 | Сообщение № 4

Группа: Друзья

Ранг: Участник клуба

Сообщений: 2566

Репутация: 724 ±

Замечаний: 0% ±

Excel 2010

Цитата Апострофф, 16.10.2018 в 16:33, в сообщении № 2 ()

т.е. это один и тот же объект

Спасибо, не знал, что в обратку тоже связывается и изменяется!

Цитата _Boroda_, 16.10.2018 в 16:46, в сообщении № 3 ()

после создания первого словаря по нему создайте второй

Спасибо! По идее вот так должно быть побыстрее?
[vba]

Код

    Set dic2 = CreateObject("Scripting.Dictionary")
        For Each k In dic1.keys
            dic2.Item(k) = dic1.Item(k)
        Next

[/vba]
сейчас потестирую

Яндекс: 410016850021169

Ответить

_Boroda_

Дата: Вторник, 16.10.2018, 17:12 | Сообщение № 5

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16672

Репутация: 6479 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

Тогда уж сразу всё в одну кучу
[vba]

Код

For Each k In dic1.keys
If dic1.Item(k) <> q Then dic2.Item(k) = dic1.Item(k)
Next

[/vba]
Я в первом посте просто для понятности все подробно описал, будет же кто-нибудь еще читать

Ответить

sboy

Дата: Вторник, 16.10.2018, 17:33 | Сообщение № 6

Группа: Друзья

Ранг: Участник клуба

Сообщений: 2566

Репутация: 724 ±

Замечаний: 0% ±

Excel 2010

Цитата _Boroda_, 16.10.2018 в 17:12, в сообщении № 5 ()

Тогда уж сразу всё в одну кучу

не, в кучу мне не надо) котлеты отдельно, мухи отдельно(с)
Потестировал заполнение словаря по другому словарю и по массивам ключей и значений
массив данных 1048576
запустил по 10 раз каждый вариант

К сообщению приложен файл: 1932898.jpg (25.7 Kb)

Яндекс: 410016850021169

Ответить

_Boroda_

Дата: Вторник, 16.10.2018, 19:55 | Сообщение № 7

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16672

Репутация: 6479 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

Цитата sboy, 16.10.2018 в 17:33, в сообщении № 6 ()

в кучу мне не надо

А какой смысл сначала создавать словарь, а потом резать его? Не проще сразу создать то, что нужно?
И, кстати, основное время тратится на создание первого словаря (цикл по массиву), все остальное можно даже не считать, оно ничтожно
Я бы все-таки сделал вот так
[vba]

Код

    Dim dic1 As Object
    Dim dic2 As Object
    Set dic1 = CreateObject("Scripting.Dictionary")
    Set dic2 = CreateObject("Scripting.Dictionary")
    n_ = 1048575
    arr = Range("A1:A" & n_).Value
    With dic1
        For i = 1 To n_
            .Item(arr(i, 1)) = .Item(arr(i, 1)) + 1
        Next
        For Each k In .keys
            If .Item(k) = 3 Then dic2.Item(k) = .Item(k)
        Next
    End With

[/vba]
Но это уже как кому больше нравится, по времени работы разницы практически никакой

Ответить

sboy

Дата: Среда, 17.10.2018, 17:38 | Сообщение № 8

Группа: Друзья

Ранг: Участник клуба

Сообщений: 2566

Репутация: 724 ±

Замечаний: 0% ±

Excel 2010

Цитата _Boroda_, 16.10.2018 в 19:55, в сообщении № 7 ()

Не проще сразу создать то, что нужно?

В моем случае (не в приложенном примере) не проще, т.к. то, что нужно, дополнительно надо вычислять. Поэтому и хотел копию словарика.

Цитата _Boroda_, 16.10.2018 в 19:55, в сообщении № 7 ()

А какой смысл сначала создавать словарь, а потом резать его?

а вот эти слова заставили задуматься, и действительно смысла мало

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

Яндекс: 410016850021169

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Независимая копия объекта Scripting.Dictionary (Макросы/Sub)

Страница 1 из 1
1