Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Label
BildScreenshot zu Label Label-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen

Listview


Betrifft: Listview von: Philip
Geschrieben am: 10.07.2018 15:22:25

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

  

Betrifft: AW: Listview von: Nepumuk
Geschrieben am: 10.07.2018 17:36:48

Hallo Philip,

ja das geht. Kannst du eine Mustermappe hochladen?

Gruß
Nepumuk


  

Betrifft: AW: Listview von: Philip
Geschrieben am: 10.07.2018 19:59:56

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


  

Betrifft: AW: Listview von: Nepumuk
Geschrieben am: 11.07.2018 13:51:45

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


  

Betrifft: AW: Listview von: Philip
Geschrieben am: 11.07.2018 14:10:38

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


  

Betrifft: AW: Listview von: Nepumuk
Geschrieben am: 11.07.2018 14:16:34

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


  

Betrifft: AW: Listview von: Philip
Geschrieben am: 11.07.2018 14:22:14

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


  

Betrifft: AW: Listview von: Nepumuk
Geschrieben am: 11.07.2018 15:40:14

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


  

Betrifft: AW: Listview von: Philip
Geschrieben am: 11.07.2018 16:29:36

Hallo
Kommt eine Fehlermeldung: Die Average-Eigenschaft de WorksheetFunction kann nicht zugeordnet werden.

lstItem.SubItems(vntItem) = .Round(.Average(avntValues), 1)
Gruss Philip


  

Betrifft: AW: Listview von: Nepumuk
Geschrieben am: 11.07.2018 17:03:15

Hallo

in deiner Mustermappe nicht.

Gruß
Nepumuk


  

Betrifft: AW: Listview von: Philip
Geschrieben am: 11.07.2018 17:14:27

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


  

Betrifft: AW: Listview von: Nepumuk
Geschrieben am: 11.07.2018 17:15:23

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


  

Betrifft: Noch eine Frage von: Philip
Geschrieben am: 11.07.2018 20:12:25

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


  

Betrifft: AW: Noch eine Frage von: Philip
Geschrieben am: 12.07.2018 05:51:15

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


  

Betrifft: AW: Noch eine Frage von: Nepumuk
Geschrieben am: 12.07.2018 12:01:32

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


  

Betrifft: AW: Noch eine Frage von: Philip
Geschrieben am: 12.07.2018 12:07:16

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


  

Betrifft: AW: Noch eine Frage von: Nepumuk
Geschrieben am: 12.07.2018 13:46:07

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


  

Betrifft: AW: Noch eine Frage von: Philip
Geschrieben am: 12.07.2018 14:05:24

Hallo Nepumuk
Nochmals Danke für deine Hilfe. Jetzt funktionierts wie ich es gerne wollte.


Gruss Philip


  

Betrifft: Hier geht's weiter, falls doch weitere Fragen :-) von: lupo1
Geschrieben am: 13.07.2018 12:11:56

... damit die Threads sich nicht rechts aus dem Bildschirm quälen.