Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Независимая копия объекта Scripting.Dictionary - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Независимая копия объекта Scripting.Dictionary (Макросы/Sub)
Независимая копия объекта Scripting.Dictionary
sboy Дата: Вторник, 16.10.2018, 15:32 | Сообщение № 1
Группа: Друзья
Ранг: Старожил
Сообщений: 2198
Репутация: 624 ±
Замечаний: 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)
 
Ответить
СообщениеДоброго дня всем.
Подскажите как правильно делать копию словарика. Я заполняю словарик, делаю копию. В копии удаляю ненужные мне элементы. Но они и в оригинальном словаре тоже удаляются. А мне он нужен целым и невредимым)
Пример вот такой написал
[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]

Автор - sboy
Дата добавления - 16.10.2018 в 15:32
Апострофф Дата: Вторник, 16.10.2018, 16:33 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 166
Репутация: 65 ±
Замечаний: 0% ±

Excel 2003
Привет!
Наверно потому, что
Цитата
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]
 
Ответить
СообщениеПривет!
Наверно потому, что
Цитата
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]

Автор - Апострофф
Дата добавления - 16.10.2018 в 16:33
_Boroda_ Дата: Вторник, 16.10.2018, 16:46 | Сообщение № 3
Группа: Модераторы
Ранг: Местный житель
Сообщений: 13514
Репутация: 5529 ±
Замечаний: 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
 
Ответить
СообщениеИли после создания первого словаря по нему создайте второй
[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_
Дата добавления - 16.10.2018 в 16:46
sboy Дата: Вторник, 16.10.2018, 16:53 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 2198
Репутация: 624 ±
Замечаний: 0% ±

Excel 2010
Цитата Апострофф, 16.10.2018 в 16:33, в сообщении № 2 ()
т.е. это один и тот же объект

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

Спасибо! По идее вот так должно быть побыстрее?
[vba]
Код
    Set dic2 = CreateObject("Scripting.Dictionary")
        For Each k In dic1.keys
            dic2.Item(k) = dic1.Item(k)
        Next
[/vba]
сейчас потестирую
 
Ответить
Сообщение
Цитата Апострофф, 16.10.2018 в 16:33, в сообщении № 2 ()
т.е. это один и тот же объект

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

Спасибо! По идее вот так должно быть побыстрее?
[vba]
Код
    Set dic2 = CreateObject("Scripting.Dictionary")
        For Each k In dic1.keys
            dic2.Item(k) = dic1.Item(k)
        Next
[/vba]
сейчас потестирую

Автор - sboy
Дата добавления - 16.10.2018 в 16:53
_Boroda_ Дата: Вторник, 16.10.2018, 17:12 | Сообщение № 5
Группа: Модераторы
Ранг: Местный житель
Сообщений: 13514
Репутация: 5529 ±
Замечаний: 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]
Я в первом посте просто для понятности все подробно описал, будет же кто-нибудь еще читать


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеТогда уж сразу всё в одну кучу
[vba]
Код
For Each k In dic1.keys
       If dic1.Item(k) <> q Then  dic2.Item(k) = dic1.Item(k)
Next
[/vba]
Я в первом посте просто для понятности все подробно описал, будет же кто-нибудь еще читать

Автор - _Boroda_
Дата добавления - 16.10.2018 в 17:12
sboy Дата: Вторник, 16.10.2018, 17:33 | Сообщение № 6
Группа: Друзья
Ранг: Старожил
Сообщений: 2198
Репутация: 624 ±
Замечаний: 0% ±

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

не, в кучу мне не надо) котлеты отдельно, мухи отдельно(с)
Потестировал заполнение словаря по другому словарю и по массивам ключей и значений
массив данных 1048576
запустил по 10 раз каждый вариант
К сообщению приложен файл: 1932898.jpg(25.7 Kb)
 
Ответить
Сообщение
Тогда уж сразу всё в одну кучу

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

Автор - sboy
Дата добавления - 16.10.2018 в 17:33
_Boroda_ Дата: Вторник, 16.10.2018, 19:55 | Сообщение № 7
Группа: Модераторы
Ранг: Местный житель
Сообщений: 13514
Репутация: 5529 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
в кучу мне не надо

А какой смысл сначала создавать словарь, а потом резать его? Не проще сразу создать то, что нужно?
И, кстати, основное время тратится на создание первого словаря (цикл по массиву), все остальное можно даже не считать, оно ничтожно
Я бы все-таки сделал вот так
[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]
Но это уже как кому больше нравится, по времени работы разницы практически никакой


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

А какой смысл сначала создавать словарь, а потом резать его? Не проще сразу создать то, что нужно?
И, кстати, основное время тратится на создание первого словаря (цикл по массиву), все остальное можно даже не считать, оно ничтожно
Я бы все-таки сделал вот так
[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]
Но это уже как кому больше нравится, по времени работы разницы практически никакой

Автор - _Boroda_
Дата добавления - 16.10.2018 в 19:55
sboy Дата: Среда, 17.10.2018, 17:38 | Сообщение № 8
Группа: Друзья
Ранг: Старожил
Сообщений: 2198
Репутация: 624 ±
Замечаний: 0% ±

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

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

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

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

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

Автор - sboy
Дата добавления - 17.10.2018 в 17:38
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Независимая копия объекта Scripting.Dictionary (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2018 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!