Страницы: 1
RSS
Убрать пустые строки из выпадающего списка ComboBox
 
Здравствуйте всем !

Есть проблемы с выпадающим списком из Combobox формы:
список для заполнения ComboBox лежит на соседнем листе и имеет пустые строки среди заполненных
Сделал так:
Для заполнения списка ComboBox использовал свойство RowSourse и диспетчер имен
В диспетчере имен сделал наименование  "Tovar" и и ссылку на диапазон соседнего листа в виде  

=СМЕЩ(Данные_Вып_список!$С$4;0;0;СЧЁТЗ(Данные_Вып_список!$С$4:С$500);1)

и в RowSourse  соответственно  = Tovar

Проблема 1:  в диапазоне соседнего листа для заполнения ComboBox имеются пустые строки между заполненными строками -  ссылка на диапазон в виде СМЕЩ и СЧЁТЗ не помогают (разрывы строк в Combobox остаются)

Проблема 2: сам диспетчер имен и занесение в него ссылок подобного типа - дело неблагодарное тк постоянно диспетчер глючит и меняет ссылки непонятно почему

Как заменить диспетчер имен макросом  который учтет пробелы и не будет их показывать в ComboBox ?

Свой пример в файле приложил.

Изменено: oleg355 - 26.05.2018 20:09:15
 
Цитата
oleg355 написал: Для заполнения списка ComboBox использовал свойство RowSourse и диспетчер имен
Используйте для заполнения Вашего ComboBox'а его свойство .List, в которое вносите заранее подготовленный массив значений (без 'пустых' в Вашем случае)
На форуме масса примеров. Или в интернете: 'Заполнить ComboBox массивом значений. VBA'
Согласие есть продукт при полном непротивлении сторон
 
Так тоже самое получатся
Код
Private Sub UserForm_Activate()
ComboBox1.Text = "" 'обнуляем значение Combobox при запуске
'ComboBox1.RowSource = "Tovar"
ComboBox1.ListRows = 20
Call FullCombobox
End Sub

B соответственно сам макрос
Код
Sub FullCombobox()
Dim shBase As Worksheet
Dim lrow As Long
Dim arr, i&
Set shBase = ActiveWorkbook.Sheets("Данные_Вып_список")
With shBase
    lrow = .Cells(Rows.Count, 3).End(xlUp).Row
    arr = .Range(.Cells(4, 3), .Cells(lrow, 3)).Value
    ComboBox1.List = arr
End With
End Sub 

А вот как забирать только непустые строки в Combobox (1 вариант)  либо убрать пустые строки в самом Combobox (2 вариант) - не знаю и какой вариант лучше тоже не знаю
 
Вы получили массив (arr). Пройдитесь, дополнительно, по нему циклом и оставьте только не пустые(<> Empty), а у же потом вносите в ComboBox
Согласие есть продукт при полном непротивлении сторон
 
Удалите в свойствах КомбоБокс RowSource и добавьте эту процедуру в модуль формы. И нужно кроме пустых строк исключить из списка "заголовки" разделов. Но требуется знать признак.
Код
Private Sub UserForm_Initialize()
Dim i As Long, x As Long, LRow As Long
    LastRow = Cells(Rows.Count, 3).End(xlUp).Row
    Set shBase = ActiveWorkbook.Sheets("Данные_Вып_список")
    With shBase
        LRow = .Cells(Rows.Count, 3).End(xlUp).Row
        arr = .Range(.Cells(4, 3), .Cells(LRow, 3)).Value
    End With
    For i = 1 To UBound(arr)
        If arr(i, 1) <> "" Then
            x = x + 1
        End If
    Next
    ReDim arr2(1 To x, 1 To 1)
    x = 0
    For i = 1 To UBound(arr)
        If arr(i, 1) <> "" Then
            x = x + 1
            arr2(x, 1) = arr(i, 1)
        End If
    Next
    ComboBox1.List = arr2
End Sub



 
Все работает супер ( но до этого я бы точно долго ковырялся - с массивами плохо) Багодарю Юрий М, Sanja !
Насчет заголовков которые нужно исключить из списка "заголовки" разделов - они будут заключены в двойные << .... >>
например << Стенки гостиные >>  - те нужно arr3 вводить и снова проверять на эти условия уже ?  и как это поймать ?
 
oleg355, если плюнуть на скорость и особенности кода, то
Код
Sub УбратьВсеПустыеВСтолбце0()
Dim i&
ComboBox1.List = Range("A1:A120").Value
For i = ComboBox1.ListCount - 1 To 0 Step -1
  If IsEmpty(ComboBox1.List(i, 0)) Then ComboBox1.RemoveItem i 'else exit for 'Снять ремарку, если пустые только в конце
Next
End Sub
 
Не нужен третий массив. Может лучше использовать наличие/отсутствие заливки?
 
Чтото не подумал об этом - точно с заливкой проще  те использовать If arr(i, 1) <> "" And arr(i, 1)..Interior.Color = xlNone   так ?
Изменено: oleg355 - 26.05.2018 22:43:41
 
Цитата
oleg355 написал:
с заливкой проще
Но тогда будет немного медленнее - будем перебирать не элементы массива, а ячейки. Пойдёт?
 
If arr(i, 1) <> "" And arr(i, 1).Interior.Color = xlNone  - так не проходит вариант  только с ячейками остается
Изменено: oleg355 - 26.05.2018 22:49:07
 
Конечно! Ведь в массиве нет цветной заливки :)
 
чето я вспомнил пример что было когдато .Interior.Color = 16777215 это работает none и xlNone не работает  на нахождение незалитых строк
Изменено: oleg355 - 26.05.2018 23:01:10
 
С перебором ячеек листа:
Код
Private Sub UserForm_Initialize()
Dim i As Long, x As Long, LRow As Long
    Set shBase = ActiveWorkbook.Sheets("Данные_Вып_список")
    With shBase
        LRow = .Cells(Rows.Count, 3).End(xlUp).Row
        For i = 7 To LRow
            If .Cells(i, 3) <> "" Then
                If .Cells(i, 3).Interior.ColorIndex = xlNone Then x = x + 1
            End If
        Next
        ReDim arr(1 To x, 1 To 1)
        x = 0
        For i = 7 To LRow
            If .Cells(i, 3) <> "" Then
                If .Cells(i, 3).Interior.ColorIndex = xlNone Then
                    x = x + 1
                    arr(x, 1) = .Cells(i, 3)
                End If
            End If
        Next
    End With
    ComboBox1.List = arr
End Sub



 
А вариант из #7 не пробовали?
 
Юрий М еще раз благодарю ! За идею заливки и код (мне такого пока не сделать) ! #7 не пробовал еще .. я так понимаю что там из комбобокса уже пустые строки изымаются
Изменено: oleg355 - 26.05.2018 23:12:04
 
oleg355, да, и только...
 
AAF тоже благодарю за помощь - ваш код тоже работает !
 
Так сделал
Код
Private Sub UserForm_Activate()
ComboBox1.Text = "" 'обнуляем значение Combobox при запуске
'ComboBox1.RowSource = "Tovar"
ComboBox1.ListRows = 20
Call УбратьВсеПустыеВСтолбце0
End Sub

и соответственно код
Код
Sub УбратьВсеПустыеВСтолбце0() 
Dim i&
ComboBox1.List = ActiveWorkbook.Sheets("Данные_Вып_список").Range("C4:C500").Value
For i = ComboBox1.ListCount - 1 To 0 Step -1
  If IsEmpty(ComboBox1.List(i, 0)) Then ComboBox1.RemoveItem i 'else exit for 'Снять ремарку, если пустые только в конце
Next
End Sub
 
oleg355, добавлю свои пять копеек с учетом идеи Юры:
Код
Sub НеПустыеИБезЗаливки()
Dim i&, a(), x, rngSourse as range
Set rngSourse = Range("A1:A120")
ReDim a(1 To rngSourse.Rows.Count)
For Each x In rngSourse
  If Not IsEmpty(x.Value) Then If x.Interior.ColorIndex = xlNone Then i = i + 1: a(i) = x.Value
Next
ReDim Preserve a(1 To i): ComboBox1.List = a
End Sub
Изменено: AAF - 26.05.2018 23:32:15
 
AAF спасибо ваш код тоже супер - все работает !
 
oleg355, но работает, если столбец исходных данных один.
Если несколько, то надо другой, но скорость поменьше...   :)
 
У меня вот так работает. Я только начинаю программировать в VBA, может так не очень корректно, но работает.
Код
Dim i As Long
With Range("!A1:A10")
            For i = 1 To 10
                If .Cells(i) <> "" Then
                ComboBox1.AddItem .Cells(i)
                End If
            Next
End With
Ну или второй вариант, тоже работает
Код
Dim c As Range
For Each c In Sheets("Данные для ввода").Range("A2:A10")
    If c.Value <> "" Then
    Me.ComboBox1.AddItem c.Value
    End If
Next
Изменено: Gegerd - 28.10.2021 09:57:28
Страницы: 1
Наверх