2016-08-03 21 views
-1

Hallo, ich habe diese Suchbox und Listbox in meiner VBA und arbeiten großartig, um Daten zu suchen, aber ich werde nicht mehr Spalten zeigen die Neimes und Preis thets es in Excel Hallo, ich habe diese Suche in listbox und großer Arbeit von Daten zu suchen, aber ich möchte in der Listbox mehr Spalten zu zeigen, zum Beispiel Spalt aus ExcelWie fügt man mehr Spalten zu VBA Listbox mit searchbox

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 
+0

Könnten Sie bitte Ihre Frage bearbeiten. Es gibt mehrere Tippfehler. Sie haben auch viel irrelevanten Code. –

+0

Entschuldigung mein Englisch ist es wirklich nicht gut Ich habe eine Listbox mit Suchoption DATEN .DATA und Zeit ist in C Excel Columne Ich möchte A Spalte B Spalten E Spalten F Columne in einer Listbox angezeigt, wenn ich suche – d00nn12345

Antwort

0

Dies ist ein minimalistisches Beispiel zu laden, wie mehr Spalten in einem Listenfeld zu füllen, indem über eine Tabelle iterieren.

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 
+0

thets Arbeit zu suchen aber dosent schow die Zellen nur Zelle C zeigt – d00nn12345

+0

Es zeigt nur 1 Spalte? –

+0

ja nur 1 Spalte sein Schowing – d00nn12345