PDA

Vollständige Version anzeigen : Automatische Ermittlung von Jahreszugehörigkeit anhand von Blattnamen


Mumpitz1
16.07.2014, 14:14
Hallo zusammen,

ich hoffe hier kann mir geholfen werden.

Die Situation:
- Ich habe ein Dokument mit mehreren Blättern (ein Blatt heißt "Personen" und die anderen haben Jahreszahlen mit ".1" oder ".2" als Endung, also bsp.: "2014.2", "2014.1", "2013.2" usw.)
- Auf Blatt 1 sind untereinander in Spalte A Eintrittsjahre von Personen, in Spalte B die Personalnummern und in Spalte C die Namen dieser Personen.
- Die Personen haben eine bestimmte Laufzeit, die "Eintrittsjahr" + 2,5 Jahre beträgt.
- Auf den Jahresblättern sollen nun automatisch nur die Namen erscheinen, die in diesem Jahr aktiv sind (also sich in der Zeitspanne von "Eintrittsjahr" + 2,5 befinden)

Das ist mein erstes Problem.

Mal schauen ob das möglich ist :/

Vielen Dank schon mal :)

Liebe Grüße

BrunMi
16.07.2014, 14:20
Hallo,

Kannst du mal bitte eine Beispieldatei mit anonymisierten Daten hochladen?
Ich würd wohl versuchen das Problem über ein Makro zu lösen.
Das ist jedoch erheblich einfacher wenn man auf der Originaldatei arbeitet, als auf einer von mir nachgestellten Datei..

Wenn du mir eine Beispieldatei hochlädst versuch ich mal mein Glück ;)

LG
BrunMi

Mumpitz1
16.07.2014, 14:38
Ja, anders wird es vermutlich nicht zu lösen sein.

Wenn ich eine Erklärung bekomme, wie es funktioniert, wäre das super :)

Hier die Datei.

GMG-CC
16.07.2014, 23:18
Moin,

entweder ich habe dich falsch verstanden oder das sind die falschen Daten.
Denn: Selbst wenn jemand Januar 2012 eingetreten ist, dann sind das heute noch nicht einmal 2 Jahre her ... Also weit weniger als 2 Jahre 6 Monate, die du als Frist gesetzt hast.

Und warum fehlt der Januar und "als Ausgleich" ist der Juli doppelt?
Und gilt immer das Halbjahr (Blatt) als solches?

Hasso
17.07.2014, 06:17
Hallo Günther,Selbst wenn jemand Januar 2012 eingetreten ist, dann sind das heute noch nicht einmal 2 Jahre herMal ohne Excel gerechnet: Januar 2012 bis 17.07.2014 sind 2 Jahre und 5 bis 6 Monate... :D

Mumpitz1
17.07.2014, 09:05
Also das 1. Halbjahr geht immer von August bis Januar und das 2. dann von Februar bis Juli. So steht es auch in der Datei (zumindest in "2014.1" und "2014.2")

Das Problem existiert aber ja trotzdem, wenn die Liste nun jemand enthalten würde, der vor 2012 eingetreten ist. In meinem Beispiel steht jetzt niemand drin aber so weit kann man ja selbst denken. Außerdem vergeht die Zeit ja, also irgendwann ist der Punkt gekommen, an dem jemand über die 2,5 Jahre kommt.

Das zweite Problem ist übrigens Folgendes:
Auf dem ersten Blatt, soll immer die Abteilung abgehakt (x) werden, die von der Person im Plan schon durchlaufen wurde. Dazu sollen natürlich immer nur die Halbjahres-Blätter durchsucht werden, auf denen die jeweilige Person auch steht.

Danke schon mal für die rege Beteiligung :)

BrunMi
17.07.2014, 09:41
Hallo Mumpitz,

Wie versprochen habe ich mich mal an Punkt 1 versucht und diesen meiner Meinung nach auch zur Zufriedenheit gelöst.
Das Problem:
Hättest du mir doch vorher gesagt, dass es einen Punkt 2 gibt und wie dieser aussieht.
Mein Makro löscht nämlich alle in den Jahrestabellen eingetragenen Werte und füllt die Tabellen dann neu mit den jeweiligen Namen.
Wer wo bisher gearbeitet hat (die X) gehen also dann verloren.

Wenn Punkt 2 auch noch realisiert werden soll, muss man wohl oder übel bei jeder Tabelle jeden Namen vergleichen und je nachdem die Namen nachtragen oder eben wecklassen.


Hier mal trotzdem mein Makro. Vielleicht kannst du damit ja was anfangen.

Sub NamenUebertragen()
Dim letzteZeile As Integer
Dim i As Integer
Dim Eintrittsjahr As Integer
Dim j As Integer
Dim halbeBegrenzer As Integer
Dim letzteZeileSheet As Integer

letzteZeile = Sheets("Azubis").Cells(Rows.Count, 2).End(xlUp).Row

For i = 2 To Worksheets.Count
Sheets(i).Select
Range("A3:M274").Select
Selection.ClearContents
Next i

For i = 2 To letzteZeile
If Not Sheets("Azubis").Cells(i, 1) = "" Then
Eintrittsjahr = Sheets("Azubis").Cells(i, 1)

halbeBegrenzer = 1

For j = 0 To 2

If Not WorkSheetExists(Eintrittsjahr + j & ".1") Then
Sheets.Add After:=Sheets("Azubis")
Sheets(2).Name = Eintrittsjahr + j & ".1"
Sheets(3).Select
Sheets(3).Range("A1:I2").Copy Sheets(2).Range("A1:I2")
Sheets(2).Cells(1, 1) = Eintrittsjahr + j & ".1"
End If

letzteZeileSheet = Sheets(Eintrittsjahr + j & ".1").Cells(Rows.Count, 1).End(xlUp).Row
Sheets(Eintrittsjahr + j & ".1").Cells(letzteZeileSheet + 1, 1) = Sheets("Azubis").Cells(i, 2)
Sheets(Eintrittsjahr + j & ".1").Cells(letzteZeileSheet + 1, 2) = Sheets("Azubis").Cells(i, 3)
Sheets(Eintrittsjahr + j & ".1").Cells(letzteZeileSheet + 1, 3) = Sheets("Azubis").Cells(i, 4)

If halbeBegrenzer < 3 Then

If Not WorkSheetExists(Eintrittsjahr + j & ".2") Then
Sheets.Add After:=Sheets("Azubis")
Sheets(2).Name = Eintrittsjahr + j & ".2"
Sheets(3).Select
Sheets(3).Range("A1:I2").Copy Sheets(2).Range("A1:I2")
Sheets(2).Cells(1, 1) = Eintrittsjahr + j & ".2"
End If

letzteZeileSheet = Sheets(Eintrittsjahr + j & ".2").Cells(Rows.Count, 1).End(xlUp).Row
Sheets(Eintrittsjahr + j & ".2").Cells(letzteZeileSheet + 1, 1) = Sheets("Azubis").Cells(i, 2)
Sheets(Eintrittsjahr + j & ".2").Cells(letzteZeileSheet + 1, 2) = Sheets("Azubis").Cells(i, 3)
Sheets(Eintrittsjahr + j & ".2").Cells(letzteZeileSheet + 1, 3) = Sheets("Azubis").Cells(i, 4)
End If

halbeBegrenzer = halbeBegrenzer + 1
Next j
End If
Next i

End Sub

Public Function WorkSheetExists(ByVal strName As String) As Boolean
On Error Resume Next
WorkSheetExists = Not Worksheets(strName) Is Nothing
End Function

Im Anhang findest du noch deine Beispieldatei mit eingebautem Makro.
Bitte in Zukunft gleich die ganze Aufgabenstellung offenbaren. Dann hätte ich nicht sinnlos dieses doch eher aufwändige Makro programmiert..

LG
BrunMi

BrunMi
17.07.2014, 11:50
Hallo Mumpitz,

Ich hab mich jetzt nochmal dran gesetzt und es funktioniert bei mir jetzt so weit mal alles was du so gefordert hast.

Hier mein Code:

Sub NamenUebertragen()
Dim letzteZeile As Integer
Dim i As Integer
Dim Eintrittsjahr As Integer
Dim j As Integer
Dim k As Integer
Dim halbeBegrenzer As Integer
Dim letzteZeileSheet As Integer
Dim NameVorhanden As Boolean

letzteZeile = Sheets("Azubis").Cells(Rows.Count, 2).End(xlUp).Row

For i = 2 To letzteZeile
If Not Sheets("Azubis").Cells(i, 1) = "" Then
Eintrittsjahr = Sheets("Azubis").Cells(i, 1)

halbeBegrenzer = 1

For j = 0 To 2

If Not WorkSheetExists(Eintrittsjahr + j & ".1") Then
Sheets.Add After:=Sheets("Azubis")
Sheets(2).Name = Eintrittsjahr + j & ".1"
Sheets(3).Select
Sheets(3).Range("A1:I2").Copy Sheets(2).Range("A1:I2")
Sheets(2).Cells(1, 1) = Eintrittsjahr + j & ".1"
End If

letzteZeileSheet = Sheets(Eintrittsjahr + j & ".1").Cells(Rows.Count, 1).End(xlUp).Row

'Schauen ob die Personalnummer in dem Sheet schon vorhanden ist
NameVorhanden = False
For k = 3 To letzteZeileSheet + 1
If Sheets("Azubis").Cells(i, 2) = Sheets(Eintrittsjahr + j & ".1").Cells(k, 1) Then
NameVorhanden = True
End If
Next k

'Wenn die Personalnummer im Sheet nicht vorhanden ist wird sie an der letzten Stelle eingetragen
If NameVorhanden = False Then
Sheets(Eintrittsjahr + j & ".1").Cells(letzteZeileSheet + 1, 1) = Sheets("Azubis").Cells(i, 2)
Sheets(Eintrittsjahr + j & ".1").Cells(letzteZeileSheet + 1, 2) = Sheets("Azubis").Cells(i, 3)
Sheets(Eintrittsjahr + j & ".1").Cells(letzteZeileSheet + 1, 3) = Sheets("Azubis").Cells(i, 4)
End If

If halbeBegrenzer < 3 Then

If Not WorkSheetExists(Eintrittsjahr + j & ".2") Then
Sheets.Add After:=Sheets("Azubis")
Sheets(2).Name = Eintrittsjahr + j & ".2"
Sheets(3).Select
Sheets(3).Range("A1:I2").Copy Sheets(2).Range("A1:I2")
Sheets(2).Cells(1, 1) = Eintrittsjahr + j & ".2"
End If

letzteZeileSheet = Sheets(Eintrittsjahr + j & ".2").Cells(Rows.Count, 1).End(xlUp).Row

'Schauen ob die Personalnummer in dem Sheet schon vorhanden ist
NameVorhanden = False
For k = 3 To letzteZeileSheet + 1
If Sheets("Azubis").Cells(i, 2) = Sheets(Eintrittsjahr + j & ".2").Cells(k, 1) Then
NameVorhanden = True
End If
Next k

'Wenn die Personalnummer im Sheet nicht vorhanden ist wird sie an der letzten Stelle eingetragen
If NameVorhanden = False Then
Sheets(Eintrittsjahr + j & ".2").Cells(letzteZeileSheet + 1, 1) = Sheets("Azubis").Cells(i, 2)
Sheets(Eintrittsjahr + j & ".2").Cells(letzteZeileSheet + 1, 2) = Sheets("Azubis").Cells(i, 3)
Sheets(Eintrittsjahr + j & ".2").Cells(letzteZeileSheet + 1, 3) = Sheets("Azubis").Cells(i, 4)
End If
End If

halbeBegrenzer = halbeBegrenzer + 1
Next j
End If
Next i

End Sub

Public Function WorkSheetExists(ByVal strName As String) As Boolean
On Error Resume Next
WorkSheetExists = Not Worksheets(strName) Is Nothing
End Function

Sub AbteilungenAbgleichen()
Dim letzteZeile As Integer
Dim i As Integer
Dim Personalnummer As String
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim letzteZeileSheet As Integer
Dim ZeileAzubi As Integer
Dim letzteSpalteJahr As Integer
Dim Abteilung As String
Dim SpalteAzubiAbteilung As Integer
Dim vorhanden As Boolean

letzteZeile = Sheets("Azubis").Cells(Rows.Count, 2).End(xlUp).Row

'i = Zähler für alle Azubis
For i = 2 To letzteZeile
Personalnummer = Sheets("Azubis").Cells(i, 2)
'j = Zähler für die Worksheets
For j = 2 To Sheets.Count
vorhanden = False
letzteZeileSheet = Sheets(j).Cells(Rows.Count, 1).End(xlUp).Row

'k = Zähler für alle Zeilen im Jahressheet
For k = 3 To letzteZeileSheet
If Sheets(j).Cells(k, 1) = Personalnummer Then
ZeileAzubi = k
vorhanden = True
End If
Next k
If vorhanden = True Then
letzteSpalteJahr = Sheets(j).Cells(ZeileAzubi, 256).End(xlToLeft).Column

If letzteSpalteJahr > 3 Then
'k ist jetzt der Zähler der die Spalten in der Jahrestabelle durchschaut (also die Abteilungen)
For k = 4 To letzteSpalteJahr
If Not Sheets(j).Cells(ZeileAzubi, k) = "" Then
Abteilung = Sheets(j).Cells(ZeileAzubi, k)

'Zählt alle Abteilungen im Sheet Azubis durch
For l = 5 To Sheets("Azubis").Cells(1, 256).End(xlToLeft).Column
If Abteilung = Sheets("Azubis").Cells(1, l) Then
SpalteAzubiAbteilung = l
End If
Next l

Sheets("Azubis").Cells(i, SpalteAzubiAbteilung) = "x"

End If
Next k
End If
End If
Next j
Next i
End Sub



Verständlich ist der zwar nicht, aber funktionieren tut er (bei mir zumindest)
Im Anhang schicke ich dir noch deine Beispieldatei. Dort habe ich das Makro bereits integriert.
Hab das Ganze jetzt auf 2 Makros aufgeteilt.
Eines das die Namen von der Tabelle Azubis mit den Namen in den Jahrestabellen abgleicht und fehlende Namen in den Jahreslisten ergänzt (NamenUebertragen)

und eines, dass alle Tabellen nach eingetragenen Abteilungen durchsucht und in der Azubitabelle ein x macht bei erledigten Abteilungen.

LG
BrunMi