Thema: Zellbereich prüfen mit Makro auf Inhalt prüfen

Hallo zusammen,
ich habe ein Problem für die Prüfung eines Zellbereiches durch ein Makro.
Was soll das Makro machen?
Ich bin dabei in Excel einen Urlaubsplan für 25 Mitarbeiter zu erstellt (Sheet Gruppe_1)
Jeder Mitarbeiter ist einer von fünf Untergruppen (A, B, C, D, E) zugeordnet, die in einem wiederkehrenden Rhythmus sog. "freie Tage" haben.
Diese freien Tage habe ich in einem anderen Tabellenblatt (Sheet "Freie_Tage") per "index" Formeln für jede Untergruppe abgebildet.
Ich möchte jetzt per Makro prüfen, welcher Untergruppe der Mitarbeiter zugeordnet ist und dann sollen die Werte aus der entsprechenden Zeile des Tabellenblattes "Freie_Tage" kopiert und in die Zeile des Mitarbeiters eingefügt werden.

Meine momentaner Ansatz das zu lösen ist so:

Sub pruefen()
Dim rg As Range
Set rg = ActiveSheet.Range("D11:D37") 'Hier stehen die Untergruppen A bis E
If rg. Was müsste hier hin? Value = "A" Then
Sheets("Freie_Tage").Select
Range("J3:AN3").Select
Selection.Copy
Sheets("Gruppe 1").Select
und jetzt sollten die kopierten Werte zu jeder Zeile (ab Spalte G) hinzugefügt werden, bei der in Spalte D ein "A" steht
ElseIf rg. Was müsste hier hin? Value = "B" Then
Sheets("Freie_Tage").Select
Range("J4:AN4").Select
Selection.Copy
Sheets("Gruppe 1").Select
und jetzt sollten die kopierten Werte zu jeder Zeile (ab Spalte G) hinzugefügt werden, bei der in Spalte D ein "B" steht
(usw. Bis die Zellbereich in Spalte D auf A, B, C, D, E geprüft ist)
End If
End Sub

Ich hoffe, ich konntes mein "Problem" einigermaßen verständlich darstellen und bin für jede Unterstützung dankbar.

Gruß
Frank

Hallöchen,

mal als erster Tipp - prüfe, in welcher Gruppe der Mitarbeiter ist. Das habe ich in Deinem Code nicht gefunden.

dann ein zweiter Tipp - Du schreibst Set rg = ActiveSheet.Range("D11:D37") 'Hier stehen die Untergruppen A bis E
D11:D37 sind mehr als 5 Zeilen. A bis E sind aber nur 5 Gruppen. Was steht da sonst noch?
Oder stehen in D11:D37 die Mitarbeiter? Wo stehen dann die Gruppen? Stehen die vielleicht auf den "Gruppenblättern"? Wie erfolgt dann die Zuordnung?
Oder steht da in D11 ein A und drunter die zugehörenden Namen, dann ein B ...
Beschreibe doch mal ganz genau, was in jeder der einzelnen Zellen steht.

und jetzt sollten die kopierten Werte zu jeder Zeile (ab Spalte G) hinzugefügt werden Ab G1? Oder G2? Schlimmstenfalls erst ab G3?

Hallo,
ok, ist etwas unverständlich beschrieben, sorry.

Die 25 Mitarbeiter sind auf die 5 Untergruppen A bis E aufgeteilt, d.h. es gibt in jeder Untergruppe mehrere Mitarbeiter ( die Untergruppen sind zu den Mitarbeiter durcheinander zugeordnet) .

Ja , die entsprechend dem Kürzel A bis E kopierten Werte aus dem Tabellenblatt "Freie_Tage" sollen dann ab Spalte G in die Zeile des Mitarbeiters eingefügt werden.

Ich habe hier ein Foto der Datei hochgeladen:


Eventuell hilft das ein wenig.

Gruß
Frank

Hallo,
ergänzend noch, mir ist die Zuordnung der Mitarbeiter zu den Untergruppen erstmal nicht bekannt.
Zum Beispiel kann der "Mitarbeiter 1" in Gruppe A, Gruppe B, Gruppe C Gruppe D oder Gruppe E sein.
genauso "Mitarbeiter 2" usw.

Deshalb die gesamte Prüfung der Spalte "D" im Makro in welcher Gruppe der einzelne Mitarbeiter ist und dann das Einfügen der entsprechenden Werte.

Ich habe zwar mit:
Sub freie_Tage()
'Mitarbeiter 1
If Range("D10").Value = "A" Then
Sheets("Sternchen1").Select
Range("J3:AN3").Select
Selection.Copy
Sheets("Gruppe 1").Select
Range("G10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ElseIf Range("D10").Value = "B" Then
Sheets("Freie_Tage").Select
Range("J4:AN4").Select
Selection.Copy
Sheets("Gruppe 1").Select
Range("G10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ElseIf Range("D10").Value = "C" Then
Sheets("Freie_Tage").Select
Range("J5:AN5").Select
Selection.Copy
Sheets("Gruppe 1").Select
Range("G10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ElseIf Range("D10").Value = "D" Then
Sheets("Freie_Tage").Select
Range("J6:AN6").Select
Selection.Copy
Sheets("Gruppe 1").Select
Range("G10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ElseIf Range("D10").Value = "E" Then
Sheets("Freie_Tage").Select
Range("J7:AN7").Select
Selection.Copy
Sheets("Gruppe 1").Select
Range("G10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

eine Möglichkeit gefunden, die Untergruppe für jeden einzelnen Mitarbeiter zu prüfen, das sind aber pro Mitarbeiter 5 Prüfungen, d.h. für Januar wären das für die 25 Mitarbeiter 125 Prüfungen der Untergruppen im Makro, bei 12 Monaten wären das dann 1500.

Es wäre super, wenn sich das besser lösen lassen würde.

Gruß
Frank

Hallöchen,

also, erst mal kannst Du Deine Code einkürzen und statt If...Then dann Select Case verwenden. Im Prinzip

Select Case Range("D10").Value 

  Case "A"

  Sheets("Sternchen1").Range("J3:AN3").Copy

  Sheets("Gruppe 1").Range("G10").PasteSpecial Paste:=xlPasteValues

  Case "B"

  '...

End Select

Dann natürlich eine Schleife für die Mitarbeiter drum herum, also

For iCnt = 4 To 28 'Schleife von Zeile 4 bis 28?

Select Case Cells(iCnt, 4).Value 

  Case "A"

  Sheets("Sternchen1").Range("J3:AN3").Copy

  Sheets("Gruppe 1").Cells(iCnt, 7).PasteSpecial Paste:=xlPasteValues

  Case "B"

  '...

End Select

Next

Man könnte noch eine Prüfung einbauen falls Du weniger Mitarbeiter hast, damit die Schleife z.B. bei einer leeren Zelle verlassen wird.

Hallo schauan,
die Lösung mit der Schleife funktioniert perfekt.

Vielen, vielen Dank.

Gruß
Frank