gefilterte Daten in Listbox ändern bzw. löschen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

'Daten ändern Private Sub CommandButton6_Click() Dim wb As Workbook Dim z As String Set wb = ThisWorkbook z = wb.Worksheets("Kategorien").Cells(Rows.Count, 4).End(xlUp).Row With Range("Kategorien!B2:F" & z) Me.Tag = "1" .Cells(ListBox1.ListIndex + 1, 1).Value = TextBox1 .Cells(ListBox1.ListIndex + 1, 2).Value = TextBox2 .Cells(ListBox1.ListIndex + 1, 3).Value = TextBox3 .Cells(ListBox1.ListIndex + 1, 4).Value = TextBox4 .Cells(ListBox1.ListIndex + 1, 5).Value = TextBox5 Me.Tag = "" End With TextBox1 = "" TextBox2 = "" TextBox3 = "" TextBox4 = "" TextBox5 = "" ListBox1.Value = "" Call ListBox1_fuellen End Sub

Hallo Peter,
ich hab mal alles überflüssige gelöscht:

Option Explicit

Sub ListBox1_fuellen()

    Dim lZeile As Long
    Dim lLibox As Long

    Call ListBox1.Clear

    With ThisWorkbook.Worksheets("Kategorien")
        For lZeile = 2 To .Cells(.Rows.Count, 3).End(xlUp).Row
            If Not .Rows(lZeile).Hidden Then
                Call ListBox1.AddItem
                ListBox1.List(lLibox, 0) = .Cells(lZeile, 2).Value
                ListBox1.List(lLibox, 1) = .Cells(lZeile, 3).Value
                ListBox1.List(lLibox, 2) = .Cells(lZeile, 4).Value
                ListBox1.List(lLibox, 3) = .Cells(lZeile, 5).Value
                ListBox1.List(lLibox, 4) = .Cells(lZeile, 6).Value
                ListBox1.List(lLibox, 5) = lZeile
                lLibox = lLibox + 1
            End If
        Next
    End With
End Sub

'ListBox1 füllen
Private Sub CommandButton1_Click()
    Call ListBox1_fuellen
End Sub

'Beenden
Private Sub CommandButton2_Click()
    Call Unload(Object:=Me)
End Sub

'filtern
Private Sub CommandButton3_Click()
    Call ThisWorkbook.Worksheets("Kategorien").Rows(1).AutoFilter(Field:=4, Criteria1:=TextBox4.Text)
End Sub

'Filter beenden
Private Sub CommandButton4_Click()
    With ThisWorkbook.Worksheets("Kategorien")
        If .FilterMode Then Call .ShowAllData
    End With
    Call ListBox1_fuellen
End Sub

'Filtern und Listbox füllen
Private Sub CommandButton5_Click()

    Call ThisWorkbook.Worksheets("Kategorien").Rows(1).AutoFilter(Field:=4, Criteria1:=TextBox4.Text)

    Call ListBox1_fuellen

End Sub

'Daten ändern
Private Sub CommandButton6_Click()

    Application.EnableEvents = False

    With ThisWorkbook.Worksheets("Kategorien")
        .Cells(Clng(ListBox1.List(ListBox1.ListIndex, 5)), 2).Value = Val(TextBox1.Text)
        .Cells(Clng(ListBox1.List(ListBox1.ListIndex, 5)), 3).Value = TextBox2.Text
        .Cells(Clng(ListBox1.List(ListBox1.ListIndex, 5)), 4).Value = TextBox3.Text
        .Cells(Clng(ListBox1.List(ListBox1.ListIndex, 5)), 5).Value = TextBox4.Text
        .Cells(Clng(ListBox1.List(ListBox1.ListIndex, 5)), 6).Value = TextBox5.Text
    End With

    Application.EnableEvents = True

    TextBox1.Text = vbNullString
    TextBox2.Text = vbNullString
    TextBox3.Text = vbNullString
    TextBox4.Text = vbNullString
    TextBox5.Text = vbNullString

    Call ListBox1_fuellen
End Sub

'Auswahl aus Listbox in Textbox zur Änderung falls falscher Eintrag
Private Sub ListBox1_Click()

    TextBox1.Text = ListBox1.List(ListBox1.ListIndex, 0)
    TextBox2.Text = ListBox1.List(ListBox1.ListIndex, 1)
    TextBox3.Text = ListBox1.List(ListBox1.ListIndex, 2)
    TextBox4.Text = ListBox1.List(ListBox1.ListIndex, 3)
    TextBox5.Text = ListBox1.List(ListBox1.ListIndex, 4)

End Sub

Private Sub UserForm_Initialize()
    With ListBox1
        .ColumnCount = 6
        .Font.Size = 8
        .ColumnWidths = "1cm;4cm;5cm;4cm;4cm;0cm"
    End With
End Sub

Gruß
Nepumuk

Private Sub CommandButton7_Click() Dim lngRow As Long Application.EnableEvents = False With ThisWorkbook.Worksheets("Kategorien") .Rows(CLng(ListBox1.List(ListBox1.ListIndex, 5))).Delete For lngRow = 2 To .Cells(.Rows.Count, 2).End(xlUp) .Cells(lngRow, 2).Value = lngRow - 1 Next .AutoFilter.ApplyFilter End With Application.EnableEvents = True TextBox1.Text = vbNullString TextBox2.Text = vbNullString TextBox3.Text = vbNullString TextBox4.Text = vbNullString TextBox5.Text = vbNullString Call ListBox1_fuellen End Sub

Private Sub CommandButton9_Click() Dim Ende As Long Dim Ende2 As Long With ThisWorkbook.Worksheets("Kategorien") Ende = .Cells(.Rows.Count, 3).End(xlUp).Row ' - 1 .Range("$B$1:$F" & Ende).AutoFilter Field:=4, Criteria1:=TextBox4.Text End With With ThisWorkbook.Worksheets("Kategorien") Ende = .Cells(.Rows.Count, 2).End(xlUp).Row ' - 1 Range("B2:B65656").SpecialCells(xlVisible).EntireRow.Delete End With With ThisWorkbook.Worksheets("Kategorien") 'Anfang Filter aufheben If .FilterMode Then Call .ShowAllData 'hebt den Filter auf Selection.AutoFilter 'schaltet Daten - Filter ab 'Ende Filter aufheben 'Anfang Nummerierung der Spalte B Ende = .Cells(.Rows.Count, 3).End(xlUp).Row 'benötigt _ für Nummerierung .Range("B2:B3").AutoFill Destination:=Range("B2:B" & Ende), Type:=xlFillDefault 'führt _ die Nummerierung erneut durch End With 'Ende Nummerierung der Spalte B End Sub

Hallo Peter,
im anderen Makro war noch ein Fehler. Daher:

Private Sub CommandButton7_Click()
    Dim lngRow As Long
    Dim blnFilterMode As Boolean
    If ListBox1.ListIndex > -1 Then
        Application.EnableEvents = False
        With ThisWorkbook.Worksheets("Kategorien")
            If .FilterMode Then
                blnFilterMode = True
                Call .ShowAllData
            End If
            Call .Cells(Clng(ListBox1.List(ListBox1.ListIndex, 5)), 2).Resize(1, 5).Delete(Shift:=xlShiftUp)
            For lngRow = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
                .Cells(lngRow, 2).Value = lngRow - 1
            Next
            If blnFilterMode Then Call .Rows(1).AutoFilter(Field:=4, Criteria1:=TextBox4.Text)
        End With
        Application.EnableEvents = True
        TextBox1.Text = vbNullString
        TextBox2.Text = vbNullString
        TextBox3.Text = vbNullString
        TextBox4.Text = vbNullString
        TextBox5.Text = vbNullString
        Call ListBox1_fuellen
    Else
        Call MsgBox("Bitte einen Eintrag auswählen.", vbExclamation, "Hinweis")
    End If
End Sub

Private Sub CommandButton8_Click()
    Dim lngIndex As Long, lngRow As Long
    Dim blnFilterMode As Boolean
    If ListBox1.ListCount > 0 Then
        If MsgBox("Wirklich alle löschen?", vbQuestion Or vbOKCancel, "Abfrage") = vbOK Then
            Application.EnableEvents = False
            With ThisWorkbook.Worksheets("Kategorien")
                If .FilterMode Then
                    blnFilterMode = True
                    Call .ShowAllData
                End If
                For lngIndex = 0 To ListBox1.ListCount - 1
                    Call .Cells(Clng(ListBox1.List(lngIndex, 5)), 2).Resize(1, 5).Delete(Shift:=xlShiftUp)
                Next
                For lngRow = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
                    .Cells(lngRow, 2).Value = lngRow - 1
                Next
            End With
            Application.EnableEvents = True
            TextBox1.Text = vbNullString
            TextBox2.Text = vbNullString
            TextBox3.Text = vbNullString
            TextBox4.Text = vbNullString
            TextBox5.Text = vbNullString
            Call ListBox1.Clear
        End If
    Else
        Call MsgBox("Es sind keie Einträge vorhanden.", vbExclamation, "Hinweis")
    End If
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

gefilterte Daten in Listbox ändern bzw. löschen

28
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

gefilterte Daten in Listbox ändern bzw. löschen

28 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

28
Beiträge zum Forumthread

Beiträge zu diesem Forumthread