VBAに列を追加する方法

Question

こんにちはこのVBAの検索ボックスとリストボックスがあり、データを検索するのにはうまくいきますが、もっと多くの列を表示するにはExcelと価格を入力してください こんにちはリストボックス内のデータで検索する素晴らしい仕事が、私はこれはでリストボックスで複数の列を記入する方法のミニマルな例であるエクセル

Option Explicit 
Private loActive As Excel.ListObject 
Private Sub UserForm_Activate() 
Set loActive = ActiveSheet.ListObjects(1) 
Me.lstDetail.TextColumn = 2 
Me.lstDetail.MatchEntry = fmMatchEntryComplete 
End Sub 
Sub ResetFilter() 
Dim rngTableCol As Excel.Range 
Dim varTableCol As Variant 
Dim RowCount As Long 
Dim collUnique As Collection 
Dim FilteredRows() As String 
Dim i As Long 
Dim ArrCount As Long 
Dim FilterPattern As String 
Dim UniqueValuesOnly As Boolean 
Dim UniqueConstraint As Boolean 
Dim CaseSensitive As Boolean 
'the asterisks make it match anywhere within the string 
If Not ValidLikePattern(Me.txtFilter.Text) Then 
    Exit Sub 
End If 
FilterPattern = "*" & Me.txtFilter.Text & "*" 
UniqueValuesOnly = Me.chkUnique.Value 
CaseSensitive = Me.chkCaseSensitive 
'used only if UniqueValuesOnly is true 
Set collUnique = New Collection 
Set rngTableCol = loActive.ListColumns(1).DataBodyRange 
'note that Transpose won't work with > 65536 rows 
varTableCol = Application.WorksheetFunction.Transpose(rngTableCol.Value) 
RowCount = UBound(varTableCol) 
ReDim FilteredRows(1 To 2, 1 To RowCount) 
For i = 1 To RowCount 
    If UniqueValuesOnly Then 
     On Error Resume Next 
     'reset for this loop iteration 
     UniqueConstraint = False 
     'Add fails if key isn't UniqueValuesOnly 
     collUnique.Add Item:="test", Key:=CStr(varTableCol(i)) 
     If Err.Number <> 0 Then 
      UniqueConstraint = True 
     End If 
     On Error GoTo 0 
    End If 
    'True if UniqueValuesOnly is false or if 
    'UniqueValuesOnly is True and this is the 
    'first occurrence of the item 
    If Not UniqueConstraint Then 
     'Like operator is case sensitive, 
     'so need to use LCase if not CaseSensitive 
     If (Not CaseSensitive And LCase(varTableCol(i)) Like  LCase(FilterPattern)) _ 
      Or (CaseSensitive And varTableCol(i) Like FilterPattern) Then 
      'add to array if ListBox item matches filter 
      ArrCount = ArrCount + 1 
      'there's a hidden ListBox column that stores the record num 
      FilteredRows(1, ArrCount) = i 
      FilteredRows(2, ArrCount) = varTableCol(i) 
     End If 
    End If 
Next i 
If ArrCount > 0 Then 
    'delete empty array items 
    'a ListBox cannot contain more than 65536 items 
    ReDim Preserve FilteredRows(1 To 2, 1 To   Application.WorksheetFunction.Min(ArrCount, 65536)) 
Else 
    're-initialize the array 
    Erase FilteredRows 
End If 
If ArrCount > 1 Then 
    Me.lstDetail.List = Application.WorksheetFunction.Transpose(FilteredRows) 
Else 
    Me.lstDetail.Clear 
    'have to add separately if just one match 
    'or we get two rows, not two columns, in ListBox 
    If ArrCount = 1 Then 
     Me.lstDetail.AddItem FilteredRows(0, 1) 
     Me.lstDetail.List(0, 1) = FilteredRows(2, 1) 
    End If 
End If 
End Sub 

Private Sub txtFilter_Change() 
ResetFilter 
End Sub 

Private Sub chkCaseSensitive_Click() 
ResetFilter 
End Sub 
Private Sub chkUnique_Click() 
ResetFilter 
End Sub 

Answer 1

から、それに列をロードするためにリストボックスに例えば複数の列を表示したいですテーブルを反復する。

Private loActive As Excel.ListObject 

Private Sub Example() 

    Dim r As Range 
    Dim i As Integer 

    lstDetail.ColumnCount = 6 
    lstDetail.ColumnWidths = "" 

    Set loActive = ActiveSheet.ListObjects(1) 

    For Each r In loActive.ListColumns(1).Range 

     lstDetail.AddItem r.Value 
     i = lstDetail.ListCount - 1 

     lstDetail.List(i, 1) = r.Cells(1, "B") 
     lstDetail.List(i, 2) = r.Cells(1, "C") 
     lstDetail.List(i, 3) = r.Cells(1, "E") 
     lstDetail.List(i, 4) = r.Cells(1, "F") 
     lstDetail.List(i, 5) = r.Address 'Test Column 
    Next 

End Sub