Заполнение списка с ранее отфильтрованными данными получает только первую строку - PullRequest
Новая
       12

Заполнение списка с ранее отфильтрованными данными получает только первую строку

0 голосов
/ 30 октября 2019

Я пытаюсь заполнить список списком информации из отфильтрованной базы данных, и все работает правильно, за исключением того, что на дисплее отображается только первая отфильтрованная строка. Я действительно не знаю, что еще делать

Я пробовал использовать специальные ячейки (xlcelltypevisible), но это не работает.

Может кто-нибудь помочь мне увидеть, что мне не хватает?

Вот код: 

Private Sub UserForm_Initialize()

Dim Rang1 As Range
Dim LastCell As Long
Dim LastCell1 As Long
Dim WS As Worksheet

Dim Rang  As Range
Dim MyArr As Variant

Set WS = ThisWorkbook.Worksheets("Sheet1")

      'Define last row
      With WS

        LastCell = .Range("A" & Sheets("Mt-Gral").Rows.Count).End(xlUp).Row

      End With

      'Define filtering range
      Set Rang = WS.Range("A2:Q" & LastCell)

        'Filter
        WS.Activate

        Rang.Select

        Selection.AutoFilter Field:=10, Criteria1:="<>Closed"
        Selection.AutoFilter Field:=4, Criteria1:="<>Production"



        Set Rang1 = Rang.SpecialCells(xlCellTypeVisible)

        MyArr = Rang1

        With Me.ListBox1
            .ColumnCount = 8
            .ColumnWidths = "80pt;80pt;40pt;60pt;60pt;60pt;60pt;150pt"
            .MultiSelect = fmMultiSelectExtended
            .List = (MyArr)

1 Ответ

1 голос
/ 30 октября 2019

Вы не можете добавить все видимые ячейки в диапазоне к такому массиву, он остановится при первом пропуске ячейки, потому что вы можете назначить только один диапазон за раз, и технически вы добавляете несколькодиапазоны (поскольку вы пропускаете ячейки).

Чтобы обойти это, вы можете запустить for each для вашего отфильтрованного диапазона и добавить все видимые ячейки в ваш массив отдельно. Примерно так: 

Sub listbox()
Dim i       As Long, lastr As Long, j As Long
Dim cel     As Range
Dim Myarr() As Variant
Dim rang    As Range

lastr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
Set rang = Sheet1.Range("A2:A" & lastr)

ReDim Myarr(0 To 17, 0 To lastr)
For Each cel In rang

    If Not cel.Rows.Hidden Then
        For j = 0 To 17
            Myarr(j, i) = cel.Offset(0, j)
        Next j
        i = i + 1
    End If

Next cel
ReDim Preserve Myarr(0 To 17, 0 To i - 1)

With Sheet1.ListBox1
    .Column = Myarr
End With

End Sub

Редактировать: в соответствии с предложениями TM, я изменил способ назначения массива, адаптировал для соответствия оператор Redim и назначил его спискусо свойством .column. Это избавляет от лишних строк ближе к концу.

...