ich bitte um Hilfe bei dem folgenden Problem.
Gegeben ist die anliegende Tabelle.
Es soll bei Eintragung des Beginn und Ende Termins eines Projektes automatisch der Kalenderbereich (Spalten Z bis CA) befüllt werden, indem im entsprechenden Zeitraum die Zahl der benötigten Kräfte aus Spalte W in den Kalenderbereich eingetragen wird.
Es sind nur jene Zeilen zu befüllen, bei denen der Beginn ins Projektes innerhalb des Kalenderjahres 2016 liegt und gleichzeitig das Projekt spätestens am 31.12.18 beendet ist.
Sollten Angaben zum Datum fehlen, ist diese Zeile zu überspringen und mit der nächsten Zeile fortzusetzen.
Selbiges gilt für jene Datensätze, bei denen der Zeitraum nicht im Bereich 2016 bis 2018 liegt.
Zur Veranschaulichung habe ich die Zeilen 28 bis 30 bereits händisch ausgefüllt.
Wie könnte bitte eine VBA Lösung aussehen, die die restlichen Zeilen mit gültigen Ausfüllkriterien
(hier Zeile 15 und Zeile 23) befüllt?
Kann mir bitte jemand sagen, wie ein entsprechendes VBA Makro aussehen könnte?
14.03.2016, 00:56 (Dieser Beitrag wurde zuletzt bearbeitet: 14.03.2016, 05:54 von WillWissen.
Bearbeitungsgrund: Makro in Code-Tags gesetzt
)
Hallo,
ich denke das beigefügte Makro erfüllt diese Aufgabe.
Bitte ins vorbereite Modulblatt kopieren und selbst testen.
Das Makro ist für max. 1000 Auftraege ausgelegt.
mfg Gast 123
Code:
Option Explicit '13.3.2016 Gast 123 für Clever Forum
Dim AnfAdr As Object, EndAdr As Object
Dim AMonJahr As Date, EMonJahr As Date
Dim ATag As Integer, ETag As Integer
Dim ACol As Integer, ECol As Integer
Dim MTA As Integer, Txt As String
Dim lz As Integer, AC As Object
Public Sub Personal_Eintragung()
Range("Z10:CS1000") = Empty 'alte Liste löschen
lz = Range("X1000").End(xlUp).Row 'letzte Zelle ab 1000
For Each AC In Range("X10:X" & lz)
Txt = AC.Cells(1, 2) 'Leerzellen oder "?" überspringen
If Txt = Empty Or Left(Txt, 1) = "?" Then GoTo weiter
If AC.Value = Empty Or Left(AC, 1) = "?" Then GoTo weiter
'nur Datum ab 2016 (oder Beginn vor 2016)
If Right(AC, 4) = 2016 Or Right(Txt, 4) >= 2016 Then
ATag = Day(AC) 'Anf Tag
ETag = Left(Txt, 2) 'End Tag
MTA = AC.Cells(1, 0).Value 'Kraefte
AMonJahr = CDate("01." & Right(AC, 7)) 'Anf-Datum (01.xxx)
EMonJahr = CDate("01." & Right(Txt, 7)) 'End-Datum
'Korrektur bei Beginn vor 2016 oder Ende nach 2018
If Right(AC, 4) < 2016 Then ATag = 1: AMonJahr = CDate("01.01.2016")
If Right(Txt, 4) > 2018 Then ETag = 31: EMonJahr = CDate("01.12.2018")
'Anf-End Datum in Überschriftszeile "Z7:CS7" suchen (auf y7 vorsetzen!!)
Set AnfAdr = Range("Y7:CS7").Find(What:=AMonJahr, After:=[y7], LookIn:=xlValues, LookAt:=xlPart)
Set EndAdr = Range("Y7:CS7").Find(What:=EMonJahr, After:=[y7], LookIn:=xlValues, LookAt:=xlPart)
ACol = AnfAdr.Column 'Anf-Ende
ECol = EndAdr.Column 'Spalten Nr
If ATag > 15 Then ACol = ACol + 1
If ETag > 15 Then ECol = ECol + 1
'ermittelter Resize Bereich mit Kraefte ausfüllen
Cells(AC.Row, ACol).Resize(1, ECol - ACol + 1) = MTA
End If
weiter:
Next AC
Exit Sub
Feh: MsgBox "unerwarteter Fehler - Abbruch " & Chr(10) & Err & " " & Error()
End Sub
Beim Austesten ist mir aufgefallen, dass auch solche Zeilen ausgefüllt werden, die zeitlich nicht im Bereich 2016-2018 liegen. Das gilt z.B. für die Zeilen 13, 17, 22.
Wie könnte man das bitte korrigieren?
Nachdem ich meine Anfrage gepostet habe, ist mir aufgefallen, dass manchmal 0,3 1,5 2,3 Kräfte benötigt werden, also mit Nachkommastellen.
0,3 würde bedeuten, dass ein Mitarbeiter zu 30% seiner Arbeitszeit im Projekt eingesetzt ist, die restlichen 70% seiner Arbeitszeit fliessen in Regeltätigkeiten.
Wie würde man bitte 0,3 Mitarbeiter per VBA eintragen? Der Datentyp Integer ist in diesem Fall bekanntlich nicht geeignet.
14.03.2016, 22:31 (Dieser Beitrag wurde zuletzt bearbeitet: 15.03.2016, 06:24 von WillWissen.
Bearbeitungsgrund: Codetags gesetzt
)
Hallo VBA_noob
danke für die Rückmeldung dass mein Makro teilweise funktioniert.
Ich habe noch die Zeile 27 entdeckt: 01.01.2013 bis 31.03.2016
Meine Überlegung war, ob das noch mit rein soll? War unsicher.
Die Dim MTA bitte mal auf Double setzen (sonst auf Variant)
Einige Zeilen im Code habe ich geaendert, so sollte es dann klappen.
Bitte bis zur Set Anweisung austauschen, ab Set bleibt es wie es war.
Würde mich freuen wenn es dann gut klappt.
mfg Gast 123
Code:
Public Sub Personal_Eintragung()
Range("Z10:CS1000") = Empty 'alte Liste löschen
lz = Range("X1000").End(xlUp).Row 'letzte Zelle ab 1000
For Each AC In Range("X10:X" & lz)
Txt = AC.Cells(1, 2) 'Leerzellen oder "?" überspringen
If Txt = Empty Or Left(Txt, 1) = "?" Then GoTo weiter
If AC.Value = Empty Or Left(AC, 1) = "?" Then GoTo weiter
'nur Datum ab 2016 auflisten
If Right(AC, 4) = 2016 Then
ATag = Day(AC) 'Anf Tag
ETag = Left(Txt, 2) 'End Tag
MTA = AC.Cells(1, 0).Value 'Kraefte
AMonJahr = CDate("01." & Right(AC, 7)) 'Anf-Datum (01.xxx)
EMonJahr = CDate("01." & Right(Txt, 7)) 'End-Datum
'Korrektur bei Beginn vor 2016 oder Ende nach 2018
If Right(Txt, 4) > 2018 Then ETag = 31: EMonJahr = CDate("01.12.2018")
du hast mir gerade einen Schreck eingejagt. Dann habe ich die Datei geöffnet und nachgesehen.
İn Zeile 30 steht bei mir als Datum: 28.8.2016 bis 3.3.2018 Das wurde auch korrekt ausgewertet.
Bei mir steht die 7 von Spalte AO bis BZ. Das stimmt mit dem Datum in Überschrift Zeile 7 überein.
Ich kann bei mir keinen Fehler feststellen.
Das es dafür auch Formellösungen gibt ist mir bekannt. Das ist aber nicht mein Fachgebiet.
Für mich ist es auch unerheblich wofür der Frager sich entscheidet. Das hat er zu entscheiden.
Ich sehe mich auch nicht als Konkurrent zu altgedienten Ratgebern. Bin ein bescheidener Gast.
ich sprach von der Musterlösung des TE. Die geht in Zeile 30 nur bis zur Spalte BL! Ich habe die Formellösung in den Raum geworfen, weil ich VBA hier für überflüssig halte.
Gruß
Edgar
Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
15.03.2016, 16:49 (Dieser Beitrag wurde zuletzt bearbeitet: 15.03.2016, 17:00 von BoskoBiati.
Bearbeitungsgrund: Arbeitet auch mit mehr als 1000 Einträgen und mit Bruchteilen von Stunden.
)
Hallo,
ein bißchen VBA kann ich auch:
Code:
Option Explicit
Public Sub Personal_Eintragung()
Dim loLetzte As Long
Dim loSpalte_A As Long
Dim loSpalte_E As Long
Dim loZeile As Long
Dim dtA_Dat As Long
Dim dtE_Dat As Long
Dim wks As Worksheet
Set wks = Sheets("Planung") 'maßgebende Tabelle
loLetzte = wks.Cells(Rows.Count, 21).End(xlUp).Row 'letzte belegte Zeile in U
With wks
.Range("Z10:CZ" & loLetzte).ClearContents 'Kalenderbereich leeren
For loZeile = 10 To loLetzte
If IsDate(.Cells(loZeile, 24)) = True And IsDate(.Cells(loZeile, 25)) = True Then 'prüfen auf Datum in X u. Y
If Year(.Cells(loZeile, 24)) = 2016 And Year(.Cells(loZeile, 25)) < 2019 Then 'Anfangs- u. Endjahr prüfen
dtA_Dat = .Cells(loZeile, 24) - Day(.Cells(loZeile, 24)) + 1 'Anfang auf 1.des Monats setzen
dtE_Dat = .Cells(loZeile, 25) - Day(.Cells(loZeile, 25)) + 1 'Enddatum auf Monatsersten setzen
loSpalte_A = Application.Match(dtA_Dat, .Range("Z7:CZ7"), 0) 'Anfang im Kalender suchen
loSpalte_E = Application.Match(dtE_Dat, .Range("Z7:CZ7"), 0) + 1 'Ende im Kalender suchen
.Range(.Cells(loZeile, loSpalte_A + 25), .Cells(loZeile, loSpalte_E + 25)) = .Cells(loZeile, 23) 'Stunden eintragen
End If
End If
Next
End With
End Sub
Arbeitet auch mit mehr als 1000 Einträgen und mit Bruchteilen von Stunden.
Gruß
Edgar
Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Hallo Edgar und Gast, besten Dank für Eure Beiträge,
das neue Makro funktioniert einwandfrei. Eine Formel würde ich ebenfalls verwenden. Allerdings funktioniert die angegebene Formel bei mir nicht. Ich kann die Formel in Z10 zwar eingegeben, aber danach bleibt das Ausfüllen aus, d.h. die Zellen bleiben leer. Hätte ich 2 funktionierende Lösungen, würden höhere Mächte darüber entscheiden, welche Lösung zum Einsatz käme. Es geht aber weniger um mich, hier im Forum lesen noch viele andere Leute mit.
Besten Dank auch für den Hinweis mit der fehlerhaften Zeile Zeile 30. Im Eifer des Gefechtes habe ich diese Zeile händisch falsch ausgefüllt. Ich bitte meinen Fehlerzu entschuldigen.
01.01.2013 bis 31.03.2016 erfüllt nicht die Ausfüllkriterien, denn der 01.01.2013 liegt nicht im Zeitraum 2016-2018. Es soll ja nur dann befüllt werden, wenn beide Termine im Zeitraum 2016-2018 liegen.
Ich werde das Makro nun in den nächsten Tagen im Büro mit der "echten" Tabelle testen und mich dann wieder melden.
15.03.2016, 17:27 (Dieser Beitrag wurde zuletzt bearbeitet: 15.03.2016, 17:27 von BoskoBiati.)
Hallo,
das Makro von Gast123 hat noch einen Fehler, die Zeile 25 wird ausgefüllt, obwohl das Enddatum außerhalb des Bereichs liegt!
So sieht das bei mir mit der Formel aus, die muß man natürlich über den gesamten Bereich ziehen. Am besten den gesamten Bereich markieren, die Formel in Z10 eintragen und mit STRG+ENTER abschließen:
