Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Заполнение ComboBox ActiveX умной таблицей без пустых строк, Заполнение ComboBox ActiveX умной таблицей без пустых строк
 
#1
17.06.2025 16:20:21
Всем привет! Подскажите, я заполняю комбобокс из умной таблицы, но при этом вставляются еще миллион пустых строк после значений
Можно ли как-то заполнять комбобокс только значениями, а пустоту игнорировать

Мой код сейчас:
Код
Private Sub ComboBox1_GotFocus()
    With Worksheets("ЛДСП")
        ActiveSheet.ComboBox1.ListFillRange = .Name & "!" & .ListObjects("ЛДСП").ListColumns("Производитель").DataBodyRange.Address
    End With
End Sub
 
 
 
#2
17.06.2025 16:48:08
Код
Private Sub ComboBox1_GotFocus()
    With Worksheets("ЛДСП")
        'ActiveSheet.ComboBox1.ListFillRange = .Name & "!" & .ListObjects("ЛДСП").ListColumns("Производитель").DataBodyRange.Address
        Dim arr As Variant
        arr = .ListObjects("ЛДСП").ListColumns("Производитель").DataBodyRange.Value
        Dim dic As Object
        Set dic = CreateObject("Scripting.Dictionary")
        Dim ya As Long
        For ya = 1 To UBound(arr, 1)
            If arr(ya, 1) <> "" Then dic(arr(ya, 1)) = Empty
        Next
        
        ReDim arr(1 To dic.Count, 1 To 1)
        For ya = 1 To UBound(arr, 1)
            arr(ya, 1) = dic.Keys()(ya - 1)
        Next
        
        Dim rr As Range
        Set rr = .ListObjects("ЛДСП").DataBodyRange
        Set rr = rr.Cells(1, rr.Columns.Count + 2)
        Set rr = rr.Resize(UBound(arr, 1))
        rr.Value = arr
        
        ActiveSheet.ComboBox1.ListFillRange = .Name & "!" & rr.Address
    End With
End Sub
Предполагаю, что лишних строк в умной таблице нет, предлагать изменить размер умной таблицы до используемой области не буду.
 
 
 
#3
17.06.2025 16:56:35
МатросНаЗебре, получилось! Спасибо большое! Подскажите, а что вы имели ввиду под изменить размер умной таблицы до используемой области. Это как-то повлияет на добавление в таблицу новых данных? И как такое осуществить?
 
 
 
#4
17.06.2025 16:59:07
Если вы используете условно 100 строк, а умная таблица содержит упомянутый миллион строк, то размер умной таблицы нужно уменьшить.
Изменять размер умной таблицы можно после добавления новых данных. Можно и автоматически, и вручную.
 
 
 
#5
17.06.2025 17:00:25
МатросНаЗебре, спасибо за совет! Очень грамотное решение
 
 
 
#6
17.06.2025 17:54:31
Вариант с изменением размера исходной таблицы.
Код
Private Sub ComboBox1_GotFocus()
    With Worksheets("ЛДСП")
        ResizeLDSP
        ActiveSheet.ComboBox1.ListFillRange = .Name & "!" & .ListObjects("ЛДСП").ListColumns("Производитель").DataBodyRange.Address
    End With
End Sub

Sub ResizeLDSP()
    ResizeTable Worksheets("ЛДСП").ListObjects("ЛДСП")
End Sub

Private Sub ResizeTable(tb As ListObject)
    Dim arr As Variant
    arr = tb.Range.Value
    
    Dim xa As Long, ya As Long, ym As Long
    For xa = 1 To UBound(arr, 2)
        For ya = UBound(arr, 1) To 2 Step -1
            If arr(ya, 1) <> "" Then
                If ym < ya Then ym = ya
                Exit For
            End If
        Next
    Next
    tb.Resize tb.Range.Resize(ym)
End Sub
 
 
 
#7
18.06.2025 09:16:14
Вариант с автоматическим изменением размера умной таблицы с добавлением данных, расположенных ниже таблицы.
Срабатывает на выделение ComboBox.
Код
Option Explicit

Private Sub ComboBox1_GotFocus()
    With Worksheets("ЛДСП")
        ResizeTable Worksheets("ЛДСП").ListObjects("ЛДСП")
        ActiveSheet.ComboBox1.ListFillRange = .Name & "!" & .ListObjects("ЛДСП").ListColumns("Производитель").DataBodyRange.Address
    End With
End Sub
 
Sub ResizeLDSP()
    ResizeTable Worksheets("ЛДСП").ListObjects("ЛДСП")
End Sub
 
Private Sub ResizeTable(tb As ListObject)
    Dim arr As Variant
     arr = GetUsedRangeUnderTable(tb.Range).Value
     
    Dim xa As Long, ya As Long, ym As Long
    For xa = 1 To UBound(arr, 2)
        For ya = UBound(arr, 1) To 2 Step -1
            If arr(ya, xa) <> "" Then
                If ym < ya Then ym = ya
                Exit For
            End If
        Next
    Next
    tb.Resize tb.Range.Resize(ym)
End Sub

Private Function GetUsedRangeUnderTable(rr As Range) As Range
    Dim sh As Worksheet
    Set sh = rr.Parent
    
    Dim ym As Long
    ym = sh.UsedRange.Row + sh.UsedRange.Rows.Count - 1
    
    With sh
        Set GetUsedRangeUnderTable = .Range(rr.Cells(1, 1), .Cells(ym, rr.Column + rr.Columns.Count - 1))
    End With
End Function
 
 
 
Страницы: 1
Читают тему
Наверх