Urlaubstage übertragen

Ich steh grad völlig auf dem schlauch. Folgendes Problem:
Ich würde gerne aus Tabelle "Urlaub", aufgebaut als Jahreskalender d.h. in Zeile 7 steht das Datum und in Spalte A stehen die Namen, die "X" in die Tabelle "Aktueller Monat" übertragen lassen. Diese ist fast gleich aufgebaut d.h. Zeile 9 Datum für einen Monat Spalte A die gleichen Namen.
Das ganze als WVERWEIS in Tabelle "Aktueller Monat" zu machen ist kein Problem. Nur kann ich das ja nicht machen, da ich dort noch die Schichten eintragen muss und ich mir die Formel überschreiben würde.
Also brauche ich ein MAKRO das automatisch beim Aufrufen von "Aktueller Monat" läuft oder ich mach es über einen Button.
Ich habe es schon versucht den WVERWEIS über MAKRO aufzuzeichnen, aber dann scheitere daran das es ja nur immer für eine Zelle gilt.
Hoffe ich hab es einigermassen verständlich geschilder und es hat mir jemand einen Tipp oder einen Lösung für mein Problem.
Vielen Dank schon mal
Ghostman

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub UrlaubMarkieren() Dim wksUrlaub As Worksheet, wksAkt As Worksheet Dim rngUrlaub As Range, rngNamen As Range, rngDatum As Range Dim varName As Variant, varDatum As Variant, varWert As Variant Dim Zeile As Long, Spalte As Long Dim ZeileU As Variant, SpalteU As Variant Set wksUrlaub = Worksheets("Urlaub") Set wksAkt = Worksheets("Aktueller Monat") 'Datenbereiche im Blatt Urlaub ermitteln/festlegen ausgehend von Zelle A7 With wksUrlaub Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row Spalte = .Cells(7, .Columns.Count).End(xlToLeft).Column Set rngUrlaub = .Range(.Cells(7, 1), .Cells(Zeile, Spalte)) Set rngNamen = .Range(.Cells(7, 1), .Cells(Zeile, 1)) Set rngDatum = .Range(.Cells(7, 1), .Cells(7, Spalte)) End With With wksAkt 'Namen (Spalte A und Datum (Zeile9) im aktuellen Monat abarbeiten For Zeile = 10 To .Cells(.Rows.Count, 1).End(xlUp).Row varName = .Cells(Zeile, 1).Value For Spalte = 2 To .Cells(9, .Columns.Count).End(xlToLeft).Column varDatum = CLng(.Cells(9, Spalte).Value) 'Zeile zum Namen ermitteln ZeileU = Application.Match(varName, rngNamen, 0) 'Spalte zum Datum ermitteln SpalteU = Application.Match(varDatum, rngDatum, 0) If IsNumeric(ZeileU) And IsNumeric(SpalteU) Then varWert = Application.WorksheetFunction.Index(rngUrlaub, ZeileU, SpalteU) With .Cells(Zeile, Spalte) If UCase(varWert) = "X" Then .Value = "X" Else .ClearContents End If End With Else .Cells(Zeile, Spalte).ClearContents End If Next Next End With End Sub

Hallo Ghostman,
du hast in deiner Datei Ereignismakros und etliches an Formeln. Dadurch wird das Makro ausgebremst.
Ich hab das Makro jetzt mal angepasst, so dass es den Jahres-Kalender in 2 Halbjahren durchsucht und durch die Ereignismakros und Neuberechnungen nicht mehr ausgebremst wird.
Ausführungszeit sollte im Sekundenbereich sein.
Vor der Makroausführung sollte die Datei ggf. neu berechent werden.
Ein komplexes Makro als solches ist ja kein Problem. Die Hauptarbeit in dem Makro besteht hier darin, die Bereiche im Jahreskalender zu finden/setzen, die durchsucht werden müssen. Das ist dann das gleiche Problem, mit dem du kämpfst, wenn du mit WVERWEIS die korrekten Bereiche in den Formeln ansprechen willst.
Zusätzlich hab ich dir auch die Lösung per Formel erstellt. Auch hier müssen während der Makro-Ausführung die Ereignismakros und die Neuberechnung deaktiviert werden.
Gruß
Franz

Sub UrlaubMarkieren()
Dim wksUrlaub As Worksheet, wksAkt As Worksheet
Dim rngUrlaub As Range, rngNamen As Range, rngDatum As Range
Dim rngHJ1 As Range, rngHJ2 As Range, rngHJ As Range
Dim varName As Variant, varDatum As Variant, varWert As Variant
Dim Zeile As Long, Spalte As Long, StatusCalc As Long
Dim ZeileU As Variant, SpalteU As Variant
Set wksUrlaub = Worksheets("Urlaub")
Set wksAkt = Worksheets("Aktueller Monat")
'Makrobremsen lösen
With Application
StatusCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
'Startzelle für Halbjahre
With wksUrlaub
Set rngHJ1 = .Cells(8, 1)   'Zelle mit 1. Namen im 1. Halbjahr
Set rngHJ2 = rngHJ1.End(xlDown)
Set rngHJ2 = rngHJ2.End(xlDown) 'Zelle mit 1. Namen im 2. Halbjahr
'Datenbereich im Blatt Urlaub
If Month(wksAkt.Cells(9, 4).Value)  "U" Then Zelle.ClearContents
Next
End With
End With
'Makrobremsen zurücksetzen
With Application
.Calculation = StatusCalc
.EnableEvents = True
.ScreenUpdating = True
End With
wks.Range("D12").Value = wks.Range("D12").Value 'löst das Ereignismakro inkl. Formatieren aus
End Sub

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread