Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.10.2025 18:38:17
Zusammenfassung nach Personalnummer
16.10.2025 17:40:39
Rabattstafel
16.10.2025 17:25:38
bedingte Formatierung
16.10.2025 16:39:53
Ergebnisse nach rechts ausgeben
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1632to1636
1632to1636
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Listview

Forumthread: Listview

Listview
10.07.2018 15:22:25
Philip
Hallo zusammen
Ich habe eine Userform mit einer Textbox einem Button und einer Listview.
Die Listview befülle ich mit Werten die ich mit der Textbox in einer Tabelle suche.
Dafür habe ich folgenden Code: 

Private Sub CommandButton2_Click()
Dim rngCell As Range
Dim strFirstAddress As String
Dim lstItem As ListItem
With Worksheets("Mittelwerte").Range("E4:E700")
Me.ListView1.ListItems.Clear
Set rngCell = .Find(Me.TextBox2.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not rngCell Is Nothing Then
strFirstAddress = rngCell.Address
Do
With Me.ListView1
Set lstItem = ListView1.ListItems.Add
lstItem.Text = rngCell.Offset(0, -4).Value
lstItem.SubItems(1) = Format(rngCell.Offset(0, -3), "hh:mm")
lstItem.SubItems(2) = rngCell.Offset(0, -2).Value
lstItem.SubItems(3) = rngCell.Offset(0, -1).Value
lstItem.SubItems(4) = rngCell.Value
lstItem.SubItems(5) = rngCell.Offset(0, 1).Value
lstItem.SubItems(6) = rngCell.Offset(0, 2).Value
lstItem.SubItems(7) = rngCell.Offset(0, 3).Value
lstItem.SubItems(8) = rngCell.Offset(0, 4).Value
lstItem.SubItems(9) = rngCell.Offset(0, 5).Value
lstItem.SubItems(10) = rngCell.Offset(0, 6).Value
lstItem.SubItems(11) = rngCell.Offset(0, 7).Value
lstItem.SubItems(12) = rngCell.Offset(0, 8).Value
lstItem.SubItems(13) = rngCell.Offset(0, 9).Value
lstItem.SubItems(14) = rngCell.Offset(0, 10).Value
lstItem.SubItems(15) = rngCell.Offset(0, 11).Value
lstItem.SubItems(16) = rngCell.Offset(0, 12).Value
lstItem.SubItems(17) = rngCell.Offset(0, 13).Value
lstItem.SubItems(18) = rngCell.Offset(0, 14).Value
lstItem.SubItems(19) = rngCell.Offset(0, 15).Value
lstItem.SubItems(20) = rngCell.Offset(0, 16).Value
lstItem.SubItems(21) = rngCell.Offset(0, 17).Value
lstItem.SubItems(22) = rngCell.Offset(0, 18).Value
lstItem.SubItems(23) = rngCell.Offset(0, 19).Value
lstItem.SubItems(24) = rngCell.Offset(0, 20).Value
lstItem.SubItems(25) = rngCell.Offset(0, 21).Value
lstItem.SubItems(26) = rngCell.Offset(0, 22).Value
.FullRowSelect = True
.Gridlines = True
End With
Set rngCell = .FindNext(rngCell)
Loop While Not rngCell Is Nothing And rngCell.Address  strFirstAddress
Else
MsgBox "Belag nicht Gefunden", 48
End If
End With
End Sub

Das funktioniert soweit auch einwandfrei.
Ich möchte jetzt das in der untersten Zeile jeweils der Mittelwert der Werte aus der Listview stehen.
Ist das irgendwie machbar?
Gruss
Anzeige

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Listview
10.07.2018 17:36:48
Nepumuk
Hallo Philip,
ja das geht. Kannst du eine Mustermappe hochladen?
Gruß
Nepumuk
AW: Listview
10.07.2018 19:59:56
Philip
Hallo Nepumuk
https://www.herber.de/bbs/user/122601.xlsm
Ich habe die Bereiche gelb eingefärbt von denen ich gern den Mittelwert hätte.
Gruss Philip
Anzeige
AW: Listview
11.07.2018 13:51:45
Nepumuk
Hallo Philip,
der Mittelwert wird in der 1. Spalte ausgegeben. Ich würde da eher ein zusätzliches Label benutzen.
Private Sub CommandButton2_Click()
    Dim rngCell As Range
    Dim strFirstAddress As String
    Dim avntValues() As Variant
    Dim ialngIndex As Long
    Dim lstItem As ListItem
    With Worksheets("Mittelwerte").Range("E4:E700")
        ListView1.ListItems.Clear
        Set rngCell = .Find(Me.TextBox2.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not rngCell Is Nothing Then
            strFirstAddress = rngCell.Address
            Do
                ialngIndex = ialngIndex + 1
                Redim Preserve avntValues(1 To ialngIndex * 15)
                Set lstItem = ListView1.ListItems.Add
                lstItem.Text = rngCell.Offset(0, -4).Value
                lstItem.SubItems(1) = Format(rngCell.Offset(0, -3), "hh:mm")
                lstItem.SubItems(2) = rngCell.Offset(0, -2).Value
                lstItem.SubItems(3) = rngCell.Offset(0, -1).Value
                lstItem.SubItems(4) = rngCell.Value
                lstItem.SubItems(5) = rngCell.Offset(0, 1).Value
                lstItem.SubItems(6) = rngCell.Offset(0, 2).Value
                lstItem.SubItems(7) = rngCell.Offset(0, 3).Value
                lstItem.SubItems(8) = rngCell.Offset(0, 4).Value
                avntValues(1 + 15 * (ialngIndex - 1)) = rngCell.Offset(0, 4).Value
                lstItem.SubItems(9) = rngCell.Offset(0, 5).Value
                lstItem.SubItems(10) = rngCell.Offset(0, 6).Value
                lstItem.SubItems(11) = rngCell.Offset(0, 7).Value
                lstItem.SubItems(12) = rngCell.Offset(0, 8).Value
                avntValues(2 + 15 * (ialngIndex - 1)) = rngCell.Offset(0, 8).Value
                lstItem.SubItems(13) = rngCell.Offset(0, 9).Value
                avntValues(3 + 15 * (ialngIndex - 1)) = rngCell.Offset(0, 9).Value
                lstItem.SubItems(14) = rngCell.Offset(0, 10).Value
                avntValues(4 + 15 * (ialngIndex - 1)) = rngCell.Offset(0, 10).Value
                lstItem.SubItems(15) = rngCell.Offset(0, 11).Value
                avntValues(5 + 15 * (ialngIndex - 1)) = rngCell.Offset(0, 11).Value
                lstItem.SubItems(16) = rngCell.Offset(0, 12).Value
                avntValues(6 + 15 * (ialngIndex - 1)) = rngCell.Offset(0, 12).Value
                lstItem.SubItems(17) = rngCell.Offset(0, 13).Value
                avntValues(7 + 15 * (ialngIndex - 1)) = rngCell.Offset(0, 13).Value
                lstItem.SubItems(18) = rngCell.Offset(0, 14).Value
                avntValues(8 + 15 * (ialngIndex - 1)) = rngCell.Offset(0, 14).Value
                lstItem.SubItems(19) = rngCell.Offset(0, 15).Value
                avntValues(9 + 15 * (ialngIndex - 1)) = rngCell.Offset(0, 15).Value
                lstItem.SubItems(20) = rngCell.Offset(0, 16).Value
                avntValues(10 + 15 * (ialngIndex - 1)) = rngCell.Offset(0, 16).Value
                lstItem.SubItems(21) = rngCell.Offset(0, 17).Value
                avntValues(11 + 15 * (ialngIndex - 1)) = rngCell.Offset(0, 17).Value
                lstItem.SubItems(22) = rngCell.Offset(0, 18).Value
                avntValues(12 + 15 * (ialngIndex - 1)) = rngCell.Offset(0, 18).Value
                lstItem.SubItems(23) = rngCell.Offset(0, 19).Value
                avntValues(13 + 15 * (ialngIndex - 1)) = rngCell.Offset(0, 19).Value
                lstItem.SubItems(24) = rngCell.Offset(0, 20).Value
                avntValues(14 + 15 * (ialngIndex - 1)) = rngCell.Offset(0, 20).Value
                lstItem.SubItems(25) = rngCell.Offset(0, 21).Value
                avntValues(15 + 15 * (ialngIndex - 1)) = rngCell.Offset(0, 21).Value
                lstItem.SubItems(26) = rngCell.Offset(0, 22).Value
                Set rngCell = .FindNext(rngCell)
            Loop Until rngCell.Address = strFirstAddress
            ListView1.ListItems.Add Text:=WorksheetFunction.Average(avntValues)
        Else
            MsgBox "Belag nicht Gefunden", vbExclamation
        End If
    End With
End Sub

Gruß
Nepumuk
Anzeige
AW: Listview
11.07.2018 14:10:38
Philip
Hallo Nepumuk
Danke für deine Antwort. Ich habe mich glaube ich faltsch ausgedrückt.
Ich muss den Mittelwert aus jeder der Gelb Markierten Spalten einzeln unten dran stehen haben.
Ich hoffe das ich es verwständlich erklährt habe.
Gruss Philip
AW: Listview
11.07.2018 14:16:34
Nepumuk
Hallo Philip,
versteh ich dich richtig, pro Zeile im ListView 1mal Mittelwert berechnen? Warum dann unten dran schreiben? wäre es dann nicht logischer eine zusätzliche Spalte einzufügen?
Gruß
Nepumuk
Anzeige
AW: Listview
11.07.2018 14:22:14
Philip
Hallo Nepumuk
Nein nicht pro Zeile sondern pro Spalte, also alle Werte die zum Beispiel unter dem 0.0063 stehen ein Mittelwert, alle die unter0.125 stehen ein Mittelwert.
Gruss Philip
AW: Listview
11.07.2018 15:40:14
Nepumuk
Hallo Philip,
teste mal:
Private Sub CommandButton2_Click()
    Dim rngCell As Range
    Dim strFirstAddress As String
    Dim avntColumns() As Variant, vntItem As Variant, avntValues() As Variant
    Dim lngRow As Long
    Dim lstItem As ListItem
    With Worksheets("Mittelwerte").Range("E4:E700")
        ListView1.ListItems.Clear
        Set rngCell = .Find(Me.TextBox2.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not rngCell Is Nothing Then
            strFirstAddress = rngCell.Address
            avntColumns = Array(8, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25)
            Do
                Set lstItem = ListView1.ListItems.Add
                lstItem.Text = rngCell.Offset(0, -4).Value
                lstItem.SubItems(1) = Format(rngCell.Offset(0, -3), "hh:mm")
                lstItem.SubItems(2) = rngCell.Offset(0, -2).Value
                lstItem.SubItems(3) = rngCell.Offset(0, -1).Value
                lstItem.SubItems(4) = rngCell.Value
                lstItem.SubItems(5) = rngCell.Offset(0, 1).Value
                lstItem.SubItems(6) = rngCell.Offset(0, 2).Value
                lstItem.SubItems(7) = rngCell.Offset(0, 3).Value
                lstItem.SubItems(8) = rngCell.Offset(0, 4).Value
                lstItem.SubItems(9) = rngCell.Offset(0, 5).Value
                lstItem.SubItems(10) = rngCell.Offset(0, 6).Value
                lstItem.SubItems(11) = rngCell.Offset(0, 7).Value
                lstItem.SubItems(12) = rngCell.Offset(0, 8).Value
                lstItem.SubItems(13) = rngCell.Offset(0, 9).Value
                lstItem.SubItems(14) = rngCell.Offset(0, 10).Value
                lstItem.SubItems(15) = rngCell.Offset(0, 11).Value
                lstItem.SubItems(16) = rngCell.Offset(0, 12).Value
                lstItem.SubItems(17) = rngCell.Offset(0, 13).Value
                lstItem.SubItems(18) = rngCell.Offset(0, 14).Value
                lstItem.SubItems(19) = rngCell.Offset(0, 15).Value
                lstItem.SubItems(20) = rngCell.Offset(0, 16).Value
                lstItem.SubItems(21) = rngCell.Offset(0, 17).Value
                lstItem.SubItems(22) = rngCell.Offset(0, 18).Value
                lstItem.SubItems(23) = rngCell.Offset(0, 19).Value
                lstItem.SubItems(24) = rngCell.Offset(0, 20).Value
                lstItem.SubItems(25) = rngCell.Offset(0, 21).Value
                lstItem.SubItems(26) = rngCell.Offset(0, 22).Value
                Set rngCell = .FindNext(rngCell)
            Loop Until rngCell.Address = strFirstAddress
            With ListView1
                Redim avntValues(1 To .ListItems.Count)
                Set lstItem = .ListItems.Add
                For Each vntItem In avntColumns
                    For lngRow = 1 To .ListItems.Count - 1
                        If .ListItems(lngRow).ListSubItems(vntItem).Text = vbNullString Then
                            avntValues(lngRow) = vbNullString
                        Else
                            avntValues(lngRow) = CDbl(.ListItems(lngRow).ListSubItems(vntItem).Text)
                        End If
                    Next
                    With WorksheetFunction
                        lstItem.SubItems(vntItem) = .Round(.Average(avntValues), 1)
                    End With
                Next
            End With
        Else
            MsgBox "Belag nicht Gefunden", vbExclamation
        End If
    End With
End Sub

Sortieren wird damit aber nicht mehr funktionieren.
Gruß
Nepumuk
Anzeige
AW: Listview
11.07.2018 16:29:36
Philip
Hallo
Kommt eine Fehlermeldung: Die Average-Eigenschaft de WorksheetFunction kann nicht zugeordnet werden.

lstItem.SubItems(vntItem) = .Round(.Average(avntValues), 1)
Gruss Philip
AW: Listview
11.07.2018 17:03:15
Nepumuk
Hallo
in deiner Mustermappe nicht.
Gruß
Nepumuk
Anzeige
AW: Listview
11.07.2018 17:14:27
Philip
https://www.herber.de/bbs/user/122623.xlsm
Hallo Nepumuk
Habe die Datei nochmals hochgeladen vielleicht kannst du kurz anschauen woran es liegt oder wieso es bei mir nicht geht.
Gruss Philip
AW: Listview
11.07.2018 17:15:23
Nepumuk
Hallo,
du hast Recht, ich habe immer mit zwei oder 3 Zeilen getestet. So geht's:
Private Sub CommandButton2_Click()
    Dim rngCell As Range
    Dim strFirstAddress As String
    Dim avntColumns() As Variant, vntItem As Variant, avntValues() As Variant
    Dim lngRow As Long
    Dim blnNumber As Boolean
    Dim lstItem As ListItem
    With Worksheets("Mittelwerte").Range("E4:E700")
        ListView1.ListItems.Clear
        Set rngCell = .Find(Me.TextBox2.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not rngCell Is Nothing Then
            strFirstAddress = rngCell.Address
            avntColumns = Array(8, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25)
            Do
                Set lstItem = ListView1.ListItems.Add
                lstItem.Text = rngCell.Offset(0, -4).Value
                lstItem.SubItems(1) = Format(rngCell.Offset(0, -3), "hh:mm")
                lstItem.SubItems(2) = rngCell.Offset(0, -2).Value
                lstItem.SubItems(3) = rngCell.Offset(0, -1).Value
                lstItem.SubItems(4) = rngCell.Value
                lstItem.SubItems(5) = rngCell.Offset(0, 1).Value
                lstItem.SubItems(6) = rngCell.Offset(0, 2).Value
                lstItem.SubItems(7) = rngCell.Offset(0, 3).Value
                lstItem.SubItems(8) = rngCell.Offset(0, 4).Value
                lstItem.SubItems(9) = rngCell.Offset(0, 5).Value
                lstItem.SubItems(10) = rngCell.Offset(0, 6).Value
                lstItem.SubItems(11) = rngCell.Offset(0, 7).Value
                lstItem.SubItems(12) = rngCell.Offset(0, 8).Value
                lstItem.SubItems(13) = rngCell.Offset(0, 9).Value
                lstItem.SubItems(14) = rngCell.Offset(0, 10).Value
                lstItem.SubItems(15) = rngCell.Offset(0, 11).Value
                lstItem.SubItems(16) = rngCell.Offset(0, 12).Value
                lstItem.SubItems(17) = rngCell.Offset(0, 13).Value
                lstItem.SubItems(18) = rngCell.Offset(0, 14).Value
                lstItem.SubItems(19) = rngCell.Offset(0, 15).Value
                lstItem.SubItems(20) = rngCell.Offset(0, 16).Value
                lstItem.SubItems(21) = rngCell.Offset(0, 17).Value
                lstItem.SubItems(22) = rngCell.Offset(0, 18).Value
                lstItem.SubItems(23) = rngCell.Offset(0, 19).Value
                lstItem.SubItems(24) = rngCell.Offset(0, 20).Value
                lstItem.SubItems(25) = rngCell.Offset(0, 21).Value
                lstItem.SubItems(26) = rngCell.Offset(0, 22).Value
                Set rngCell = .FindNext(rngCell)
            Loop Until rngCell.Address = strFirstAddress
            With ListView1
                Redim avntValues(1 To .ListItems.Count)
                Set lstItem = .ListItems.Add
                For Each vntItem In avntColumns
                    blnNumber = False
                    For lngRow = 1 To .ListItems.Count - 1
                        If .ListItems(lngRow).ListSubItems(vntItem).Text = vbNullString Then
                            avntValues(lngRow) = vbNullString
                        Else
                            avntValues(lngRow) = CDbl(.ListItems(lngRow).ListSubItems(vntItem).Text)
                            blnNumber = True
                        End If
                    Next
                    If blnNumber Then
                        With WorksheetFunction
                            lstItem.SubItems(vntItem) = .Round(.Average(avntValues), 1)
                        End With
                    Else
                        lstItem.SubItems(vntItem) = 0
                    End If
                Next
            End With
        Else
            MsgBox "Belag nicht Gefunden", vbExclamation
        End If
    End With
End Sub

Gruß
Nepumuk
Anzeige
Noch eine Frage
11.07.2018 20:12:25
Philip
Hallo Nepumuk
Danke dir für deine Hilfe es funktioniert Einwandfrei.
Eine Frage habe ich jedoch noch.
Ist es auch noch möglich dass wenn ich auf eine Zeile in der Listview einen Doppelklick mache das sich der Inhalt dieser Zeile löscht und der Mittelwert neu Berechnet wird?
Gruss Philip
Anzeige
AW: Noch eine Frage
12.07.2018 05:51:15
Philip
Ich habe mal was versucht. 
Private Sub ListView1_DblClick()
Dim avntColumns() As Variant, vntItem As Variant, avntValues() As Variant
Dim lngRow As Long
Dim blnNumber As Boolean
Dim lstItem As ListItem
Dim li As MSComctlLib.ListItem
Set li = ListView1.SelectedItem
If Not li Is Nothing Then
ListView1.ListItems.Remove li.Index
End If
avntColumns = Array(8, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25)
With ListView1
ReDim avntValues(1 To .ListItems.Count)
Set lstItem = .ListItems.Add
For Each vntItem In avntColumns
blnNumber = False
For lngRow = 1 To .ListItems.Count - 1
If .ListItems(lngRow).ListSubItems(vntItem).Text = vbNullString Then
avntValues(lngRow) = vbNullString
Else
avntValues(lngRow) = CDbl(.ListItems(lngRow).ListSubItems(vntItem). _
Text)
blnNumber = True
End If
Next
If blnNumber Then
With WorksheetFunction
lstItem.SubItems(vntItem) = .Round(.Average(avntValues), 1)
End With
Else
lstItem.SubItems(vntItem) = 0
End If
Next
End With
End Sub
Es funktioniert auch fast, es schreibt mir den Mittelwert immer auf eine neue leere Zeile anstatt auf die letzte Zeile.
Gruss
Anzeige
AW: Noch eine Frage
12.07.2018 12:01:32
Nepumuk
Hallo Philip,
du fügst ja noch eine Zeile ein mit:
Set lstItem = .ListItems.Add
Du brauchst nur in der Löschroutine die letzte Zeile ansprechen. Einfach
Set lstItem = .ListItems(.ListItems.Count)
Gruß
Nepumuk
AW: Noch eine Frage
12.07.2018 12:07:16
Philip
Hallo Nepumuk
Danke dir für die Antwort und die Hilfe.
Ich finde immer neu Herausforderungen, wie kriege ich es hin das die Zeile mit den Mittelwerten rot wird.(Schriftart)
Gruss Philip
Anzeige
AW: Noch eine Frage
12.07.2018 13:46:07
Nepumuk
Hallo Philip
ein Beispiel für den CommandButton den Code für das Löschen kannst du sicher selbst anpassen:
Private Sub CommandButton2_Click()
    Dim rngCell As Range
    Dim strFirstAddress As String
    Dim avntColumns() As Variant, vntItem As Variant, avntValues() As Variant
    Dim lngRow As Long
    Dim blnNumber As Boolean
    Dim lstItem As ListItem
    With Worksheets("Mittelwerte").Range("E4:E700")
        ListView1.ListItems.Clear
        Set rngCell = .Find(Me.TextBox2.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not rngCell Is Nothing Then
            strFirstAddress = rngCell.Address
            avntColumns = Array(8, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25)
            Do
                Set lstItem = ListView1.ListItems.Add
                lstItem.Text = rngCell.Offset(0, -4).Value
                lstItem.SubItems(1) = Format(rngCell.Offset(0, -3), "hh:mm")
                lstItem.SubItems(2) = rngCell.Offset(0, -2).Value
                lstItem.SubItems(3) = rngCell.Offset(0, -1).Value
                lstItem.SubItems(4) = rngCell.Value
                lstItem.SubItems(5) = rngCell.Offset(0, 1).Value
                lstItem.SubItems(6) = rngCell.Offset(0, 2).Value
                lstItem.SubItems(7) = rngCell.Offset(0, 3).Value
                lstItem.SubItems(8) = rngCell.Offset(0, 4).Value
                lstItem.SubItems(9) = rngCell.Offset(0, 5).Value
                lstItem.SubItems(10) = rngCell.Offset(0, 6).Value
                lstItem.SubItems(11) = rngCell.Offset(0, 7).Value
                lstItem.SubItems(12) = rngCell.Offset(0, 8).Value
                lstItem.SubItems(13) = rngCell.Offset(0, 9).Value
                lstItem.SubItems(14) = rngCell.Offset(0, 10).Value
                lstItem.SubItems(15) = rngCell.Offset(0, 11).Value
                lstItem.SubItems(16) = rngCell.Offset(0, 12).Value
                lstItem.SubItems(17) = rngCell.Offset(0, 13).Value
                lstItem.SubItems(18) = rngCell.Offset(0, 14).Value
                lstItem.SubItems(19) = rngCell.Offset(0, 15).Value
                lstItem.SubItems(20) = rngCell.Offset(0, 16).Value
                lstItem.SubItems(21) = rngCell.Offset(0, 17).Value
                lstItem.SubItems(22) = rngCell.Offset(0, 18).Value
                lstItem.SubItems(23) = rngCell.Offset(0, 19).Value
                lstItem.SubItems(24) = rngCell.Offset(0, 20).Value
                lstItem.SubItems(25) = rngCell.Offset(0, 21).Value
                lstItem.SubItems(26) = rngCell.Offset(0, 22).Value
                Set rngCell = .FindNext(rngCell)
            Loop Until rngCell.Address = strFirstAddress
            With ListView1
                Redim avntValues(1 To .ListItems.Count)
                Set lstItem = .ListItems.Add
                lstItem.ForeColor = vbRed
                For Each vntItem In avntColumns
                    blnNumber = False
                    For lngRow = 1 To .ListItems.Count - 1
                        If .ListItems(lngRow).ListSubItems(vntItem).Text = vbNullString Then
                            avntValues(lngRow) = vbNullString
                        Else
                            avntValues(lngRow) = CDbl(.ListItems(lngRow).ListSubItems(vntItem).Text)
                            blnNumber = True
                        End If
                    Next
                    If blnNumber Then
                        With WorksheetFunction
                            lstItem.SubItems(vntItem) = .Round(.Average(avntValues), 1)
                            lstItem.ListSubItems(vntItem).ForeColor = vbRed
                        End With
                    Else
                        lstItem.SubItems(vntItem) = "0"
                        lstItem.ListSubItems(vntItem).ForeColor = vbRed
                    End If
                Next
            End With
        Else
            MsgBox "Belag nicht Gefunden", vbExclamation
        End If
    End With
End Sub

Gruß
Nepumuk
Anzeige
AW: Noch eine Frage
12.07.2018 14:05:24
Philip
Hallo Nepumuk
Nochmals Danke für deine Hilfe. Jetzt funktionierts wie ich es gerne wollte.
Gruss Philip
Hier geht's weiter, falls doch weitere Fragen :-)
13.07.2018 12:11:56
lupo1
... damit die Threads sich nicht rechts aus dem Bildschirm quälen.
;
Anzeige

Infobox / Tutorial

Listview in Excel VBA: So funktioniert's

Schritt-für-Schritt-Anleitung

Um eine Listview in Excel VBA zu erstellen und mit Werten zu befüllen, folge diesen Schritten:

  1. Userform erstellen: Öffne den VBA-Editor (Alt + F11), füge eine Userform hinzu und platziere eine Textbox, einen Button und eine Listview auf der Form.

  2. Listview konfigurieren: Stelle sicher, dass die Listview die gewünschte Anzahl an Spalten hat. Gehe dazu in die Eigenschaften der Listview und passe die ColumnHeaders an.

  3. VBA-Code ergänzen: Füge den folgenden Code in das Codefenster der Userform ein:

    Private Sub CommandButton2_Click()
   Dim rngCell As Range
   Dim strFirstAddress As String
   Dim lstItem As ListItem
   With Worksheets("Mittelwerte").Range("E4:E700")
       Me.ListView1.ListItems.Clear
       Set rngCell = .Find(Me.TextBox2.Value, LookIn:=xlValues, lookat:=xlWhole)
       If Not rngCell Is Nothing Then
           strFirstAddress = rngCell.Address
           Do
               With Me.ListView1
                   Set lstItem = ListView1.ListItems.Add
                   lstItem.Text = rngCell.Offset(0, -4).Value
                   ' Weitere SubItems hier hinzufügen
                   ' ...
               End With
               Set rngCell = .FindNext(rngCell)
           Loop While Not rngCell Is Nothing And rngCell.Address <> strFirstAddress
       Else
           MsgBox "Belag nicht Gefunden", vbExclamation
       End If
   End With
End Sub

  4. Mittelwerte berechnen: Um den Mittelwert der Werte aus der Listview anzuzeigen, kannst du die WorksheetFunction.Average -Funktion verwenden. Achte darauf, dass du die Werte in einem Array speicherst und am Ende den Mittelwert berechnest.

Häufige Fehler und Lösungen

  • Fehler: "Belag nicht Gefunden": Stelle sicher, dass der Suchbegriff in der Textbox genau mit einem Wert in deiner Tabelle übereinstimmt. Prüfe auch das LookIn und lookat Parameter in der .Find Methode.

  • Fehler: Mittelwert kann nicht berechnet werden: Achte darauf, dass du nur numerische Werte ins Array überträgst. Verwende CDbl um sicherzustellen, dass die Werte als Double behandelt werden.

Alternative Methoden

Eine alternative Methode zur Anzeige von Werten in Excel ist die Verwendung von DataGridView in einem Excel-Add-In oder auch die Verwendung von PivotTables zur Datenanalyse. Diese Methoden können je nach Anforderung effektiver sein.

Praktische Beispiele

  1. Listview mit Durchschnitt:

    lstItem.SubItems(0) = WorksheetFunction.Average(avntValues)

  2. Einfügen von Farbcodierungen:

    lstItem.ForeColor = vbRed

  3. Zeile löschen und Mittelwerte aktualisieren:

    Private Sub ListView1_DblClick()
   Dim li As ListItem
   Set li = ListView1.SelectedItem
   If Not li Is Nothing Then
       ListView1.ListItems.Remove li.Index
       ' Mittelwerte neu berechnen
   End If
End Sub

Tipps für Profis

  • Nutze die ListItems und ListSubItems Objekte effizient, um die Daten dynamisch zu verwalten und darzustellen.
  • Experimentiere mit der Formatierung deiner Listview, um die Benutzeroberfläche ansprechender zu gestalten.
  • Überlege, wie du zusätzliche Funktionen wie Sortierung und Filterung in deine Listview integrieren kannst, um die Benutzererfahrung zu verbessern.

FAQ: Häufige Fragen

1. Wie kann ich mehrere Spalten in einer Listview anpassen? Du kannst die ColumnHeaders in der Listview-Eigenschaft anpassen, um die Spaltenüberschriften zu ändern.

2. Wie kann ich den Inhalt der Listview sortieren? Um die Listview zu sortieren, kannst du die Sort Methode verwenden, die auf die ListItems angewendet wird.

3. Ist es möglich, die Listview mit Daten aus einer externen Datenquelle zu füllen? Ja, du kannst Daten aus einer Datenbank oder einer externen Datei in die Listview einfügen, indem du die entsprechenden VBA-Befehle und ADO/DAO verwendest.

4. Wie kann ich die Schriftfarbe einer Zeile in der Listview ändern? Verwende die ForeColor Eigenschaft des entsprechenden ListItems, um die Schriftfarbe zu ändern.

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige