AW: noch eine VBA-Variante ...
10.09.2010 21:10:17
fcs
Hallo Uwe,
hier eine etwas andere Variante des Codes für die Schaltfläche.
Gruß
Franz
Private Sub cmdIndividualplanung_Click()
Dim wksMaske1 As Worksheet, wksMaske2 As Worksheet
Dim Zeile As Long, Spalte As Long, Zeile2 As Long, Spalte1 As Long
Dim rngNamen As Range
Dim MA_Name As Variant, vKW As Variant
Set wksMaske1 = Worksheets("Maske1")
Set wksMaske2 = Worksheets("Maske2")
Application.ScreenUpdating = False
With wksMaske2
'Altdaten löschen
.Range(.Cells(6, 2), .Cells(16, 6)).ClearContents
'KW und Name merken
vKW = .Cells(3, 3).Value
MA_Name = .Cells(2, 3).Value
Zeile = 5 'Zeilenzähler für Maske2 setzen
End With
With wksMaske1
'Spalte mit Datum des 1.Tags der KW in Zeile 1 von Maske1 suchen
For Spalte = 2 To .Cells(2, .Columns.Count).End(xlToLeft).Column
If .Cells(1, Spalte).Value = vKW Then
Spalte1 = Spalte
Exit For
End If
Next
If Spalte1 = 0 Then
MsgBox "KW """ & vKW & """ nicht gefunden"
Else
'Datums der KW kopieren - nur Werte
.Range(.Cells(2, Spalte1), .Cells(2, Spalte1 + 4)).Copy
wksMaske2.Range("B5:F5").PasteSpecial Paste:=-4163 'xlPasteValues
Application.CutCopyMode = False
'Aufgabenzeilen in Maske1 abarbeiten
For Zeile2 = 4 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Bereich mit den Namen in der Zeile setzen
Set rngNamen = .Range(.Cells(Zeile2, Spalte1), .Cells(Zeile2, Spalte1 + 4))
'Prüfen, ob im Bereich der Mitarbeiter eingetragen ist
If Not rngNamen.Find(What:=MA_Name, LookIn:=xlValues, Lookat:=xlWhole) Is Nothing Then
'Zeilenzähler für Maske1 erhöhen
Zeile = Zeile + 1
'Namen in Zeile für KW vergleichen und ggf. Aufgabe eintragen
For Spalte = 1 To rngNamen.Cells.Count
If rngNamen.Cells(1, Spalte) = MA_Name Then
wksMaske2.Cells(Zeile, Spalte + 1).Value = .Cells(Zeile2, 1)
End If
Next
End If
Next
End If
End With
Range("B5").Select
Application.ScreenUpdating = False
End Sub