Excel Userform для поиска в текстовом поле и фильтрации в списке - PullRequest
Новая
       12

Excel Userform для поиска в текстовом поле и фильтрации в списке

0 голосов
/ 04 февраля 2019

Здравствуйте, я ищу помощь, у меня есть одно текстовое поле и одно окно списка в пользовательской форме Excel, оно работает безупречно, за исключением одной маленькой детали: как только результаты появляются в списке, они представляют поиск во всех столбцах.Первый столбец, однако, скрывается при вводе в текстовом поле. Как я могу убедиться, что столбец остается видимым во время поиска?Заранее спасибо

Вот код: 

Private Sub UserForm_Initialize()

End Sub

Private Sub TextBox1_Change()

With Sheets("Sheet1")

lr = .Range("A" & Rows.Count).End(xlUp).Row
ReDim arr(1 To lr - 1)
ReDim sn(1 To lr - 1, 1 To 13)
For i = 1 To UBound(arr)
    arr(i) = .Range("A" & i + 2) & " " & .Range("B" & i + 2) & " " & .Range("C" & i + 2) & " " & .Range("D" & i + 2) & " " & .Range("E" & i + 2) & " " & .Range("F" & i + 2)
    If InStr(1, arr(i), TextBox1) > 0 Then
        j = j + 1
        For X = 2 To 8
            sn(j, X - 1) = .Cells(i + 2, X)
        Next
    End If
Next
ListBox1.List = sn

End With

End Sub

1 Ответ

0 голосов
/ 05 февраля 2019

Согласованный подход к массиву

Ваш исходный код показывает смесь циклов массив и диапазон при создании отфильтрованного списка списка.Чтобы быть более последовательными здесь, зацикливаясь только на массивах *), вы можете уточнить свой код следующим образом (например, используя ту же проверку соответствия через Instr):

Процедура пользовательского события TextBox1_Change()

Private Sub TextBox1_Change()
  Const STARTROW = 3
  Dim i&, iCnt&, r&, c&                                                       ' array counters for "rows" and "columns"
  Dim sn, tmp                                                                 ' variant 2-dim 1-based arrays
  With Sheets("Sheet1")
      iCnt = .Range("A" & Rows.Count).End(xlUp).Row - STARTROW + 1            ' items counter
      ReDim sn(1 To iCnt, 1 To 13)                                            ' provide for filtered data array
      For i = 1 To iCnt
         'assign current data row to 2-dim 1-based temporary array
          tmp = .Range("A" & (i + 2) & ":F" & (i + 2))                        ' current data row (c.f. OP)
         'compare search string with concatenated data string from current row
          If InStr(1, concat(tmp), TextBox1.Text) > 0 Then                    ' check occurrence e.g. via Instr
              r = r + 1                                                       ' new rows counter
              For c = 1 To UBound(tmp, 2)                                     ' col counter
                  sn(r, c) = tmp(1, c)                                        ' collect found row data
              Next
          End If
      Next
      ListBox1.List = sn                                                      ' assign array to .List property
  End With

End Sub

Вспомогательная функция concat(), вызываемая вышеуказанной процедурой события 

Private Function concat(ByVal arr, Optional ByVal delim$ = " ") As String
' Purpose: build string from 2-dim array row, delimited by 2nd argument
' Note:    concatenation via JOIN needs a "flat" 1-dim array via double transposition
  concat = Join(Application.Transpose(Application.Transpose(arr)), delim)
End Function

Примечания

*) Цикл обхода диапазона по VBA всегда занимает много времени, поэтому вместо этого используйте массивы.

Возможно, вас также заинтересует следующее решение, демонстрирующее использование списка Свойство столбца .Играя вокруг, вы можете удалить лишние пустые строки в списке.

...