Datum Kalenderwoche zuweisen

Sub CalcCapacity() ' Berechnung der Abteilungsauslastung Dim intColDate As Integer Dim Date01, Weekday01, Date02, Weekday02, KW_DIN Date01 = Date ' Aktuelles Datum intColDate = 5 ' Spalte Fälligkeitsdatum Weekday01 = Weekday(Date01) ' Aktueller Wochentag numerisch(1,2,...) KW_DIN = DatePart("WW", Date01, vbMonday, vbFirstFourDays) ' Aktuelle Kalenderwoche Worksheets("Aufgabenübersicht").Activate

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Ich habe es nun wie folgt gelöst:


Sub CalcCapacityCurrWeek()  ' Berechnung der Abteilungsauslastung für die aktuelle Woche
Dim intColDate As Integer
Dim intColTime As Integer
Dim intCountTime As Integer
Dim intCountRow As Integer
Dim intAvailTime As Integer
Dim intColDay As Integer
Dim intColDayLast As Integer
Dim Date01, Weekday01, Date02, Weekday02, KW_Cur, KW_Sear
Date01 = Date                                               ' Aktuelles Datum
intAvailTime = 0                                            ' Verfügbare Zeit
intColDay = 14                                              ' Startspalte Nummer des Wochentags beginnt 1 vor Tag zwecks Berechnung
intColDate = 5                                              ' Spalte Fälligkeitsdatum
intColDayLast = 18                                         ' letzte Spalte Wochentag
intCountRow = 5                                             ' Zähler Reihe
intColTime = 8                                              ' Spalte Dauer
intAvailTime = 0
Weekday01 = Weekday(Date01) - 1                               ' Aktueller Wochentag numerisch(1,2,...)
KW_Cur = DatePart("WW", Date01, vbMonday, vbFirstFourDays)  ' Aktuelle Kalenderwoche
Worksheets("Aufgabenübersicht").Activate
Do While Cells(intCountRow, intColDate)  ""
KW_Sear = DatePart("WW", Cells(intCountRow, intColDate).Value, vbMonday, vbFirstFourDays)    'Abfrage KW in aktueller Zelle
If KW_Sear


Sub CalcCapacityNextWeek()  ' Berechnung der Abteilungsauslastung für die darauf folgende Woche
Dim intColDate As Integer
Dim intColTime As Integer
Dim intCountTime As Integer
Dim intCountRow As Integer
Dim intAvailTime As Integer
Dim Date01, Weekday01, Date02, Weekday02, KW_Nex, KW_Sear
Date01 = Date                                                   ' Aktuelles Datum
intColDate = 5                                                  ' Spalte Fälligkeitsdatum
intCountRow = 5                                                 ' Zähler Reihe
intColTime = 8                                                  ' Spalte Dauer
intAvailTime = 0
Weekday01 = Weekday(Date01)                                     ' Aktueller Wochentag numerisch(1,2,...)
KW_Nex = DatePart("WW", Date01, vbMonday, vbFirstFourDays) + 1  ' Aktuelle Kalenderwoche +1
Worksheets("Aufgabenübersicht").Activate
Do While Cells(intCountRow, intColDate)  ""
KW_Sear = DatePart("WW", Cells(intCountRow, intColDate).Value, vbMonday, vbFirstFourDays)   'Abfrage KW in aktueller Zelle
If KW_Sear = KW_Nex Then
intCountTime = intCountTime + Cells(intCountRow, intColTime).Value
intCountRow = intCountRow + 1
Else
intCountRow = intCountRow + 1
End If
Loop
intCountRow = 5
'------Bis hier werden die Stunden der folgenden Kalenderwoche berechnet---------------------
Worksheets("Auslastung").Activate
If KW_Nex Mod 2 = 0 Then
intAvailTime = Cells(10, 14).Value      ' Zeit ungerade KW
Else
intAvailTime = Cells(23, 14).Value      ' Zeit gerade KW
End If
Cells(25, 3).Value = intAvailTime           ' Schreibe verfügbare Zeit in Zelle
Cells(24, 3).Value = intCountTime           ' Schreibe Auslastung in Zelle
End Sub

evtl. hilft es ja jemand weiter.
LG Andi

Beliebteste Forumthreads (12 Monate)

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread