Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Option Explicit
Private Sub TextBox1_Change()
Dim rng As Range
Dim q As String
q = LCase(TextBox1.Text)
Dim c As Long
Set rng = Range("rngDaten")
Dim strToSearch As String, i As Long
Dim lRow As Long, lCol As Long
With Me.ListView1
.ListItems.Clear
For lRow = 2 To rng.Rows.Count
If InStr(LCase(rng.Cells(lRow, 1) & rng.Cells(lRow, 2) & rng.Cells(lRow, 3) & rng.Cells(lRow, 4) & rng.Cells(lRow, 5) & rng.Cells(lRow, 6)), q) Then
c = c + 1
.ListItems.Add , "x" & c, rng.Cells(lRow, 1)
For lCol = 2 To rng.Columns.Count
.ListItems(c).SubItems(lCol - 1) = rng.Cells(lRow, lCol)
Next lCol
End If
Next lRow
End With
End Sub
Private Sub UserForm_Initialize()
Dim lngZe As Long, lngSp As Long
Dim rng As Range
Dim intBreite As Integer
Set rng = Range("rngDaten")
With Me.ListView1
.FullRowSelect = True
.View = 3
.Gridlines = True
.HideSelection = False
.AllowColumnReorder = True
For lngSp = 1 To rng.Columns.Count
On Error Resume Next
intBreite = rng.Cells(1, lngSp).Comment.Text
If intBreite = 0 Then intBreite = 10
On Error GoTo 0
.ColumnHeaders.Add , , rng.Cells(1, lngSp), intBreite
Next lngSp
Call populateListView(rng)
End With
Set rng = Nothing
End Sub
Private Sub populateListView(ByVal rng As Range)
Dim lRow As Long, lCol As Long
Dim lngUnicodeFlag As Long
Dim lngPrevUnicodeFlag As Long
With Me.ListView1
.ListItems.Clear
For lRow = 1 To rng.Rows.Count
.ListItems.Add , "x" & lRow, rng.Cells(lRow, 1)
For lCol = 2 To rng.Columns.Count
.ListItems(lRow).SubItems(lCol - 1) = rng.Cells(lRow, lCol)
Next lCol
Next lRow
.ListItems.Remove (1)
End With
Me.Caption = Space(10) & Me.ListView1.ListItems.Count & " Zeilen"
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
With Me.ListView1
.SortOrder = IIf(.SortOrder, 0, 1)
.SortKey = ColumnHeader.SubItemIndex
.Sorted = True
End With
End Sub
Private Sub cmbCancel_Click()
Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim lngSp As Long
Tabelle2.Cells.Clear
For lngSp = 1 To Me.ListView1.ColumnHeaders.Count
With wksDaten.Range("rngDaten").Cells(1, lngSp)
If .Comment Is Nothing Then .AddComment
.Comment.Text CStr(Me.ListView1.ColumnHeaders(lngSp).Width)
End With
Next lngSp
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.