Eintrag wenn Datum daneben steht
25.11.2005 14:40:43
Michael
Ich habe gestern schon über mein Problem geschrieben. Leider zu unklar. Jetzt Probiere ich es nocheinmal. Ich habe mir einen Kalender zurechtgebastelt (Querformat). In SpalteA steht das Datum SpalteB ist frei und SpalteC steht eine Zahl. mein Makro trägt, wenn in SpalteA Mo und in SpalteC "4" steht die fortlaufenden Zahlen ein (siehe unteren Code). Soweit so gut. Jetzt kommt mein Problem. Das nächste Monat beginnt in SpalteD "01.Do" SpalteE ist leer und SpalteF soll das Makro die Zahlen weiter eintragen . Meine Fragen dazu.
1.Kann man unteren Code so umbasteln, daß die Zahlen von C1bis C31 und von F1bis F31 Und von I1bis I31usw. eingetragen werden wenn links davon ein Datum steht?
2. Das Makro sollte, wenn links kein Datum steht, automatisch in den nächsten Spalten weitereintragen. Beispiel Februar Datum steht von C1 bis C28 (beim Schaltjahr wäre es dann von C1 bis C29 d.h. das Makro soll dann von F1 bis F28 und dann weiter von I1 bis I31 eintragen). Ich Daß das jetzt ein bißchen klarer war.
Danke für Eure Hilfe
Sub test()
Dim ws As Worksheet, rg1 As Range, rg2 As Range, firstAdr As String, _
xRow As Long
Set ws = ActiveSheet
Set rg1 = ws.Cells
ActiveSheet.Range("A1").Activate
Set rg2 = rg1.Find("Montag", , xlValues, xlPart, xlByRows, xlNext, False)
If Not (rg2 Is Nothing) Then
firstAdr = rg2.Address
Do
If rg2.Offset(0, 1).Value = 4 Then
xRow = rg2.Row
rg2.Offset(0, 1).Value = 4
rg2.Offset(1, 1).Value = 1
rg2.Offset(2, 1).Value = ""
rg2.Offset(3, 1).Value = ""
rg2.Offset(4, 1).Value = 3
rg2.Offset(5, 1).Value = 1
rg2.Offset(6, 1).Value = ""
rg2.Offset(7, 1).Value = ""
rg2.Offset(8, 1).Value = 4
rg2.Offset(9, 1).Value = 1
rg2.Offset(10, 1).Value = ""
rg2.Offset(11, 1).Value = ""
rg2.Offset(12, 1).Value = 4
rg2.Offset(13, 1).Value = 1
rg2.Offset(14, 1).Value = ""
rg2.Offset(15, 1).Value = ""
rg2.Offset(16, 1).Value = 4
rg2.Offset(17, 1).Value = 1
rg2.Offset(18, 1).Value = ""
rg2.Offset(19, 1).Value = 3
rg2.Offset(20, 1).Value = 4
rg2.Offset(21, 1).Value = 1
rg2.Offset(22, 1).Value = ""
rg2.Offset(23, 1).Value = ""
rg2.Offset(24, 1).Value = 4
rg2.Offset(25, 1).Value = 1
rg2.Offset(26, 1).Value = ""
rg2.Offset(27, 1).Value = ""
rg2.Offset(28, 1).Value = 3
rg2.Offset(29, 1).Value = 2
rg2.Offset(30, 1).Value = ""
rg2.Offset(31, 1).Value = ""
rg2.Offset(32, 1).Value = 4
rg2.Offset(33, 1).Value = 2
rg2.Offset(34, 1).Value = ""
rg2.Offset(35, 1).Value = ""
rg2.Offset(36, 1).Value = 3
rg2.Offset(37, 1).Value = 2
rg2.Offset(38, 1).Value = 3
rg2.Offset(39, 1).Value = ""
rg2.Offset(40, 1).Value = ""
rg2.Offset(41, 1).Value = 3
rg2.Offset(42, 1).Value = 2
rg2.Offset(43, 1).Value = ""
rg2.Offset(44, 1).Value = 3
rg2.Offset(45, 1).Value = 2
rg2.Offset(46, 1).Value = 2
rg2.Offset(47, 1).Value = ""
rg2.Offset(48, 1).Value = ""
rg2.Offset(49, 1).Value = 4
End If
Set rg2 = rg1.FindNext(rg2)
Loop While (Not (rg2 Is Nothing)) And rg2.Address <> firstAdr
End If
Set rg1 = Nothing
Set rg2 = Nothing
Set ws = Nothing
End Sub