Thema Datum  Von Nutzer Rating
Antwort
28.12.2020 20:25:57 Gast50593
NotSolved
28.12.2020 20:27:15 Gast3594
NotSolved
28.12.2020 20:27:20 Gast27379
NotSolved
28.12.2020 20:27:25 Gast79073
NotSolved
Rot Hilfe bzgl. VBA Code Anpassung nötig - Auswertung nach Datumsbereich
28.12.2020 21:40:12 Gast37115
NotSolved
29.12.2020 01:39:18 Mackie
NotSolved
29.12.2020 01:45:00 Mackie
NotSolved
29.12.2020 01:59:44 Mackie
NotSolved
29.12.2020 13:10:03 Gast4343
NotSolved
29.12.2020 14:05:02 Gast85178
NotSolved
29.12.2020 14:41:24 Gast26354
NotSolved

Ansicht des Beitrags:
Von:
Gast37115
Datum:
28.12.2020 21:40:12
Views:
634
Rating: Antwort:
  Ja
Thema:
Hilfe bzgl. VBA Code Anpassung nötig - Auswertung nach Datumsbereich

Hallo zusammen,

ich habe es jetzt selbst folgendermaßen gelöst und denke so sollte es funktionieren. Bei Anmerkungen bzw. Verbesserungsvorschlägen gerne melden.

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 a1 As Integer
      Dim a2 As Integer
      Dim a3 As Integer
      Dim a4 As Integer
      Dim i As Integer
      Dim j As Integer
      Dim k As Integer
      Dim l As Integer
      Dim v1 As Integer 'Abgeschlossen
      Dim v2 As Integer 'Laufend
      Dim v3 As Integer 'Angebot
      Dim v4 As Integer '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

Start = Worksheets("Industrie Auswertung").Range("C5").Value

'Start = InputBox("Bitte Start des Auswertungszeitraumes eingeben im Datumsformat TT.MM.JJJJ:")
 
Ende = Worksheets("Industrie Auswertung").Range("D5").Value
 
'Ende = InputBox("Bitte Ende des Auswertungszeitraumes eingeben im Datumsformat TT.MM.JJJJ:")

'Dim Status
'Status = InputBox("Bitte Projektstatus eingeben und auf Groß- und Kleinschreibung achten:")
 
 
a1 = 0

v1 = 0


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) = "Abgeschlossen" Then
   
   v1 = v1 + Cells(i, w).Value
   
   a1 = a1 + 1
   
End If

Next

a2 = 0

v2 = 0

For j = p To Cells(Rows.Count, st).End(xlUp).Row
  
If Cells(j, s) >= Start And Cells(j, e) <= Ende And Cells(j, st) = "Laufend" Then
   
   v2 = v2 + Cells(j, w).Value
   
   a2 = a2 + 1
   
End If

Next

a3 = 0

v3 = 0

For k = p To Cells(Rows.Count, st).End(xlUp).Row
  
If Cells(k, s) >= Start And Cells(k, e) <= Ende And Cells(k, st) = "Angebot" Then
   
   v3 = v3 + Cells(j, k).Value
   
   a3 = a3 + 1
   
End If

Next

a4 = 0

v4 = 0

For l = p To Cells(Rows.Count, st).End(xlUp).Row
  
If Cells(l, s) >= Start And Cells(l, e) <= Ende And Cells(l, st) = "Abgelehnt" Then
   
   v4 = v4 + Cells(l, w).Value
   
   a4 = a4 + 1
   
End If

Next


'Worksheets("Industrie Auswertung").Range("C5").Value = Start

'Worksheets("Industrie Auswertung").Range("D5").Value = Ende

Worksheets("Industrie Auswertung").Range("E5").Value = "Abgeschlossen"

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

Worksheets("Industrie Auswertung").Range("E7").Value = "Angebot"

Worksheets("Industrie Auswertung").Range("E8").Value = "Abgelehnt"

Worksheets("Industrie Auswertung").Range("F5").Value = a1

Worksheets("Industrie Auswertung").Range("F6").Value = a2

Worksheets("Industrie Auswertung").Range("F7").Value = a3

Worksheets("Industrie Auswertung").Range("F8").Value = a4

Worksheets("Industrie Auswertung").Range("G5").Value = v1

Worksheets("Industrie Auswertung").Range("G6").Value = v2

Worksheets("Industrie Auswertung").Range("G7").Value = v3

Worksheets("Industrie Auswertung").Range("G8").Value = v4


'MsgBox "Für den Projektstatus " & Status & " beträgt im gewählten Zeitraum vom " & Start & " bis " & Ende & " die Anzahl Projekte " & a & " und die Anzahl Projekttage " & v & "."


ThisWorkbook.Worksheets("Industrie Auswertung").Activate

Cells(1, 1).Select


Application.ScreenUpdating = True


End Sub

Danke und viele Grüße


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
28.12.2020 20:25:57 Gast50593
NotSolved
28.12.2020 20:27:15 Gast3594
NotSolved
28.12.2020 20:27:20 Gast27379
NotSolved
28.12.2020 20:27:25 Gast79073
NotSolved
Rot Hilfe bzgl. VBA Code Anpassung nötig - Auswertung nach Datumsbereich
28.12.2020 21:40:12 Gast37115
NotSolved
29.12.2020 01:39:18 Mackie
NotSolved
29.12.2020 01:45:00 Mackie
NotSolved
29.12.2020 01:59:44 Mackie
NotSolved
29.12.2020 13:10:03 Gast4343
NotSolved
29.12.2020 14:05:02 Gast85178
NotSolved
29.12.2020 14:41:24 Gast26354
NotSolved