Hallo zusammen,

hat sich erledigt. Könnte man eigentlich noch ein Kuchendiagramm via VBA erzeugen?

Option Explicit


Sub Auswertung()


Application.ScreenUpdating = False


      Dim p As Integer
      Dim st As Integer
      Dim s As Integer
      Dim e As Integer
      Dim w As Integer
      Dim Start As Date
      Dim Ende As Date
      
      
    Dim arr, i, j, v(3), a(3)
    
    arr = Array("Abgeschlossen", "Laufend", "Angebot", "Abgelehnt")
    
    p = 4 'Erste Zeilenummer der Werte
    st = 1 'Spaltennummer Status
    s = 9 'Spaltennummer Projektstart
    e = 11 'Spaltennummer Projektende
    w = 3 'Spaltennummer Personentage
    
    
    ThisWorkbook.Worksheets("Industrie").Activate
    
    With Worksheets("Industrie Auswertung")
    
    
        Start = .Range("C5").Value
        
        Ende = .Range("D5").Value
        
        
        For j = 0 To 3
        
            For i = p To Cells(Rows.Count, st).End(xlUp).Row
            
                If Cells(i, s) >= Start And Cells(i, e) <= Ende And Cells(i, st) = arr(j) Then
                
                    v(j) = v(j) + Cells(i, w).Value
                    
                    a(j) = a(j) + 1
                    
                End If
                
            Next i
            
        Next j
        
        
        Worksheets("Industrie Auswertung").Range("E5").Value = "Beauftragt"

        Worksheets("Industrie Auswertung").Range("E6").Value = "Unklar"

        Worksheets("Industrie Auswertung").Range("E7").Value = "Abgelehnt"
        
        Worksheets("Industrie Auswertung").Range("F5").Value = a(0) + a(1)

        Worksheets("Industrie Auswertung").Range("F6").Value = a(2)

        Worksheets("Industrie Auswertung").Range("F7").Value = a(3)

        Worksheets("Industrie Auswertung").Range("G5").Value = v(0) + v(1)

        Worksheets("Industrie Auswertung").Range("G6").Value = v(2)

        Worksheets("Industrie Auswertung").Range("G7").Value = v(3)
        
        
        .Activate
        
        
        .Cells(1, 1).Select
        
        
        Application.ScreenUpdating = True
        
        
    End With
    
    
End Sub

Danke und viele Grüße