Создание списка в Combobox с условием - Страница 2

Дата: Понедельник, 16.07.2018, 22:26 | Сообщение № 21

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

Ранг: Форумчанин

Сообщений: 155

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

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

Excel 2010

Спасибо. Получилось.
С resize(999) не стал пробовать, тк не хочется ограничиваться каким-то конечным числом строк.

Дата: Суббота, 18.08.2018, 15:45 | Сообщение № 22

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

Ранг: Форумчанин

Сообщений: 155

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

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

Excel 2010

Поработав уже как пользователь с полученной своей базой, столкнулся с такой проблемой, что при количестве записей за 2000 строк, форма при загрузке начинает хорошо тормозить. В ходе разбирательства, выяснилось, что 95% нагрузки дает код, из 6 поста:
[vba]

Код

Function НетЖурналЗС(Item As Variant) As Boolean
i = 5
     Do While Sheets("Журнал ЗС").Cells(i, 1).Value <> 0
        If Item = Sheets("Журнал ЗС").Cells(i, 2).Value Then НетЖурналЗС = True: Exit Function
        i = i + 1
    Loop
End Function
Private Sub UserForm_Initialize()
i = 5
     Do While Sheets("Журнал ИБ").Cells(i, 1) <> 0
     akt2.AddItem Sheets("Журнал ИБ").Cells(i, 1)
        If Not НетЖурналЗС(Sheets("Журнал ИБ").Cells(i, 1).Value) Then
        cmbFilter.AddItem Sheets("Журнал ИБ").Cells(i, 1)
              End If
               i = i + 1
    Loop
End

[/vba]
А можно ли придумать альтернативу данному коду исходя из условий первых четырех постов данной темы, чтобы нет так сильно тормозил?

Дата: Воскресенье, 19.08.2018, 22:21 | Сообщение № 23

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

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

Сообщений: 16672

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

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

2003; 2007; 2010; 2013 RUS

Цитата Паштет, 18.08.2018 в 15:45, в сообщении № 22 ()

95% нагрузки дает код

Правильно. Для каждой ячейки ИБ мы пробегаем по каждой ячейке ЗС. Именно по ячейке, а не суем их, например, в массив, а потом бежим. Конечно долго получается.
Как вариант - создать словарь по ЗС, засунуть в массив данные по ИБ, пробежаться по этому массиву с проверкой нахождения в словаре.
Конкретно код написать хотел по-быстрому, но запутался у Вас в файле - уж очень много там всего. Был бы файлик попроще - помочь было бы полегче

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

Дата: Понедельник, 20.08.2018, 21:53 | Сообщение № 24

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

Ранг: Форумчанин

Сообщений: 155

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

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

Excel 2010

Упростил файлик по максимуму, оставив только самое необходимое.

P.S. Как же плохо изучать VBA задом наперед, но время поджимает

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

Дата: Понедельник, 20.08.2018, 22:34 | Сообщение № 25

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

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

Сообщений: 16672

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

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

2003; 2007; 2010; 2013 RUS

Во, другое дело!
Так?
[vba]

Код

Private Sub UserForm_Initialize()
    With Sheets("Журнал ЗС")
        nz_ = .Cells(.Rows.Count, 1).End(xlUp).Row - 4
        arz = .Cells(5, 1).Resize(nz_)
    End With
    Set slov = CreateObject("Scripting.Dictionary")
    With slov
        For i = 1 To nz_
            aaa = .Item(arz(i, 1))
        Next i
        With Sheets("Журнал ИБ")
            ni_ = .Cells(.Rows.Count, 1).End(xlUp).Row - 4
            ari = .Cells(5, 1).Resize(ni_)
        End With
        For i = 1 To ni_
            If Not .exists(ari(i, 1)) Then
                cmbFilter.AddItem ari(i, 1)
            End If
        Next i
    End With
  End Sub

[/vba]

А почто Вы в макросе "Кнопка2_Щелчок" все отключаете, а потом взад не включаете? Нехорошо

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

Дата: Вторник, 21.08.2018, 09:21 | Сообщение № 26

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

Ранг: Форумчанин

Сообщений: 155

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

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

Excel 2010

После выбора акта, вылетает ошибка 380.

Цитата _Boroda_, 20.08.2018 в 22:34, в сообщении № 25 ()

А почто Вы в макросе "Кнопка2_Щелчок" все отключаете, а потом взад не включаете? Нехорошо

Так вы же просили все лишнее убрать

Все включается по кнопке "выход".

Дата: Вторник, 21.08.2018, 09:44 | Сообщение № 27

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

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

Сообщений: 16672

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

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

2003; 2007; 2010; 2013 RUS

Кто такой akt2?

Цитата Паштет, 21.08.2018 в 09:21, в сообщении № 26 ()

все лишнее убрать

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

Дата: Вторник, 21.08.2018, 11:23 | Сообщение № 28

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

Ранг: Форумчанин

Сообщений: 155

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

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

Excel 2010

Цитата _Boroda_, 21.08.2018 в 09:44, в сообщении № 27 ()

Кто такой akt2?

Это Combobox у наименования "номер акта по ИБ", его закрывает cmbFilter. В приложенном файле раздвинул их, чтобы было видно. Хотя необходимость двух Combobox нужна ли?

Цитата _Boroda_, 21.08.2018 в 09:44, в сообщении № 27 ()

Прошу прощения. Удалил отключение.

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

Дата: Вторник, 21.08.2018, 11:50 | Сообщение № 29

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

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

Сообщений: 16672

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

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

2003; 2007; 2010; 2013 RUS

Правильно. Вы в Акт2 пытаетесь вставить значения, а списка-то у него нет
Или так
[vba]

Код

Private Sub cmbFilter_Change()
akt2.AddItem cmbFilter.Text
akt2.Text = cmbFilter.Text
End Sub

[/vba]
Или в предыдущем макросе заполняйте и Акт2
[vba]

Код

If Not .exists(ari(i, 1)) Then
cmbFilter.AddItem ari(i, 1)
akt2.AddItem ari(i, 1)
End If

[/vba]

Дата: Вторник, 21.08.2018, 13:20 | Сообщение № 30

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

Ранг: Форумчанин

Сообщений: 155

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

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

Excel 2010

Большущее спасибо! Стало летать, но опять не правильно подтягиваются данные.

Сообщение отредактировал Паштет - Вторник, 21.08.2018, 13:56

Дата: Вторник, 21.08.2018, 19:54 | Сообщение № 31

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

Ранг: Форумчанин

Сообщений: 155

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

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

Excel 2010

_Boroda_, рано я радовался. Ерунда вышла. Сейчас получается так, что определяется количество актов не попавших в ЗС и это число становится количеством строк в выпадающем списке. Но в списке номера идут подряд, без учета есть ли они в ЗС или нет.

Подтягивание данных под номер акта сумел сам добавить, как советовали ранее.

Дата: Среда, 22.08.2018, 12:53 | Сообщение № 32

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

Ранг: Форумчанин

Сообщений: 155

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

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

Excel 2010

В прилагаемом файле будет более наглядно:
На листе Журнал ЗС, во втором столбце указаны номера из журнала ИБ, сначала они заполнялись по порядку, но потом были пропущены акты 1308, 1309 и 1311.
Они и должны попасть в список combobox акт2/cmbfilter, но по факту туда прописываются номера 1309, 1310 и 1311.

К сообщению приложен файл: ib3_1-2-.xlsm (59.3 Kb)

Дата: Среда, 22.08.2018, 12:56 | Сообщение № 33

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

Ранг: Форумчанин

Сообщений: 155

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

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

Excel 2010

До меня дошло:
[vba]

Код

With Sheets("Журнал ЗС")
        nz_ = .Cells(.Rows.Count, 2).End(xlUp).Row - 4
        arz = .Cells(5, 2).Resize(nz_)
    End With

[/vba]
Стоило только подправить столбец.

Спасибо!

Дата: Суббота, 22.09.2018, 11:51 | Сообщение № 34

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

Ранг: Форумчанин

Сообщений: 155

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

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

Excel 2010

Решил добавить еще одно условие, на исключение позиций, которые не полностью заполнены в Журнале ИБ, в этот код:
[vba]

Код

With Sheets("Журнал ЗС")
        nz_ = .Cells(.Rows.Count, 2).End(xlUp).Row - 4
        arz = .Cells(5, 2).Resize(nz_)
    End With
    Set slov = CreateObject("Scripting.Dictionary")
    With slov
        For i = 1 To nz_
            aaa = .Item(arz(i, 1))
        Next i
        With Sheets("Журнал ИБ")
            ni_ = .Cells(.Rows.Count, 1).End(xlUp).Row - 4
            ari = .Cells(5, 1).Resize(ni_)
        End With
        For i = 1 To ni_
            If Not .exists(ari(i, 1)) Then
            akt2.AddItem ari(i, 1)
            End If
        Next i
    End With

[/vba].
Казалось, что в таком варианте будет работать, но улетел в бесконечность:
[vba]

Код

For i = 1 To ni_
            If Not .exists(ari(i, 1)) Then
                 Do While Sheets("Журнал ИБ").Cells(i, 1) <> 0
                 If Sheets("Журнал ИБ").Cells(i, 16) = "" Then
            akt2.AddItem ari(i, 1)
            End If
            Loop
            End if
        Next i
    End With

[/vba]
Что не так?

Дата: Суббота, 22.09.2018, 14:37 | Сообщение № 35

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

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

Сообщений: 16672

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

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

2003; 2007; 2010; 2013 RUS

Нет файла с непоправленным макросом и словесного описания хотелок
Более того, Sheets("Журнал ИБ").Cells(i, 1) - это ari(i, 1), зачем Вы засунули его в Do-Loop?
И что в 16-м столбце должно равняться пусто? Дата выдачи?
Короче, я смысла не понял, но исходя из Вашего кода, нужно написать вот так
[vba]

Код

With Sheets("Æóðíàë ÈÁ")
    ni_ = .Cells(.Rows.Count, 1).End(xlUp).Row - 4
    ari = .Cells(5, 1).Resize(ni_)
    ar2i = .Cells(5, 16).Resize(ni_)
End With
For i = 1 To ni_
    If Not .exists(ari(i, 1)) Then
        If ar2i(i, 1) = "" Then
            akt2.AddItem ari(i, 1)
        End If
    End If
Next i

[/vba]
* И не нужно работать с ячейками на листе, засуньте данные в массив и дальше работайте уже с ним

Дата: Суббота, 22.09.2018, 19:03 | Сообщение № 36

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

Ранг: Форумчанин

Сообщений: 155

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

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

Excel 2010

Почти верно.
Вот так вот должно быть:
[vba]

Код

If ar2i(i, 1) <> "" Then

[/vba]
Спасибо! Вы гений!