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

Вход

Регистрация

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

 

= Мир MS Excel/Отобразить отсутствующие в промежутке номера - Страница 2 - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 2 из 2
  • «
  • 1
  • 2
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Отобразить отсутствующие в промежутке номера (Макросы/Sub)
Отобразить отсутствующие в промежутке номера
AVI Дата: Среда, 10.10.2018, 16:47 | Сообщение № 21
Группа: Проверенные
Ранг: Обитатель
Сообщений: 459
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
boa, нет
К сообщению приложен файл: 3951274.jpg(40.3 Kb)


Сообщение отредактировал AVI - Среда, 10.10.2018, 16:49
 
Ответить
Сообщениеboa, нет

Автор - AVI
Дата добавления - 10.10.2018 в 16:47
_Boroda_ Дата: Среда, 10.10.2018, 17:10 | Сообщение № 22
Группа: Модераторы
Ранг: Местный житель
Сообщений: 13698
Репутация: 5587 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
А у меня вариант словаря словарей
[vba]
Код
Sub OtsutstvNom()
    t_ = Timer
    Application.ScreenUpdating = 0
    c0_ = 13
    r0_ = 2
    n0_ = Cells(Rows.Count, c0_).End(3).Row - r0_ + 1
    ar0 = Cells(r0_, c0_).Resize(n0_, 2)
    c1_ = 17
    r1_ = 2
    n1_ = Cells(Rows.Count, c1_).End(3).Row - r1_ + 1
    ar1 = Cells(r1_, c1_).Resize(n1_, 3)
    Set slov = CreateObject("Scripting.Dictionary")
    With slov
        .comparemode = 1
        For i = 1 To n1_
            Set slov1 = CreateObject("Scripting.Dictionary")
            .Add ar1(i, 1), slov1
            With slov1
                .RemoveAll
                For j = 1 To ar1(i, 2)
                    a = .Item(j)
                Next j
            End With
        Next i
        On Error Resume Next
        For k = 1 To n0_
            .Item(ar0(k, 1)).Remove ar0(k, 2)
        Next k
        For h = 1 To n1_
            ar1(h, 3) = Join(.Item(ar1(h, 1)).keys, ", ")
        Next h
        Cells(r1_, c1_).Resize(n1_, 3) = ar1
    End With
    Application.ScreenUpdating = 1
    MsgBox Format(Timer - t_, "0.00000")
End Sub
[/vba]
К сообщению приложен файл: -3-9_1.xlsm(92.5 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеА у меня вариант словаря словарей
[vba]
Код
Sub OtsutstvNom()
    t_ = Timer
    Application.ScreenUpdating = 0
    c0_ = 13
    r0_ = 2
    n0_ = Cells(Rows.Count, c0_).End(3).Row - r0_ + 1
    ar0 = Cells(r0_, c0_).Resize(n0_, 2)
    c1_ = 17
    r1_ = 2
    n1_ = Cells(Rows.Count, c1_).End(3).Row - r1_ + 1
    ar1 = Cells(r1_, c1_).Resize(n1_, 3)
    Set slov = CreateObject("Scripting.Dictionary")
    With slov
        .comparemode = 1
        For i = 1 To n1_
            Set slov1 = CreateObject("Scripting.Dictionary")
            .Add ar1(i, 1), slov1
            With slov1
                .RemoveAll
                For j = 1 To ar1(i, 2)
                    a = .Item(j)
                Next j
            End With
        Next i
        On Error Resume Next
        For k = 1 To n0_
            .Item(ar0(k, 1)).Remove ar0(k, 2)
        Next k
        For h = 1 To n1_
            ar1(h, 3) = Join(.Item(ar1(h, 1)).keys, ", ")
        Next h
        Cells(r1_, c1_).Resize(n1_, 3) = ar1
    End With
    Application.ScreenUpdating = 1
    MsgBox Format(Timer - t_, "0.00000")
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 10.10.2018 в 17:10
StoTisteg Дата: Среда, 10.10.2018, 17:12 | Сообщение № 23
Группа: Авторы
Ранг: Старожил
Сообщений: 1101
Репутация: 100 ±
Замечаний: 0% ±

Excel 2010
Я бы предложил не мучиться, а написать[vba]
Код
Type Addrs
       Ks() As String
       Its() As String
End Type
Sub ...
    Dim NewMyArray As Addrs
...
    With NewMyArray
        .Ks=Dic.Keys
        .Its=Dic.Items
    End With
[/vba]но как это на скорости скажется...


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
СообщениеЯ бы предложил не мучиться, а написать[vba]
Код
Type Addrs
       Ks() As String
       Its() As String
End Type
Sub ...
    Dim NewMyArray As Addrs
...
    With NewMyArray
        .Ks=Dic.Keys
        .Its=Dic.Items
    End With
[/vba]но как это на скорости скажется...

Автор - StoTisteg
Дата добавления - 10.10.2018 в 17:12
AVI Дата: Среда, 10.10.2018, 18:44 | Сообщение № 24
Группа: Проверенные
Ранг: Обитатель
Сообщений: 459
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
Спасибо, мужчины!
 
Ответить
СообщениеСпасибо, мужчины!

Автор - AVI
Дата добавления - 10.10.2018 в 18:44
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Отобразить отсутствующие в промежутке номера (Макросы/Sub)
  • Страница 2 из 2
  • «
  • 1
  • 2
Поиск:

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