Makroproblem
28.11.2005 13:19:42
Michael
ich habe über mein Problem geschrieben, nur leider kannte sich mit meinem Geschreibe keiner aus. Ich kann die Datei auch leider nicht hochladen (Von meiner Firma gesperrt). Jetzt probiere ich es nocheinmal und langsamer. Mein Makro trägt, wenn in der ersten Spalte "Montag" und daneben "eins" steht untereinander eine Liste ein. Die Spalten gehen aber nur von 1 bis 10. mein Makro trägt die Liste aber untereinander ein. Es sollte aber, wenn die 10 Zeile erreicht wurde, bei C1 weitereintragen und wenn C10 erreicht wurde bei E1 weitereintragen usw. Ich hoffe es kennt sich jetzt wer aus. Unten wäre eine Beispielliste
A1 _ Mi _ zwei ___ B1 _ Sa _ sechs ___ C1 _ Di _ zwei
A2 _ Do _ drei ___ B2 _ So _ sieben ___ C2 _ Mi _ drei
A3 _ Fr __ vier ___ B3 _ Mo _ eins ___ C3 _ Do _ vier
A4 _ Sa _ sechs __ B4 _ Di _ zwei ___ C4 _ Fr _ fünf
A5 _ So _ sieben _ B5 _ Mi _ drei ___ C5 _ Sa _ sechs
A6 _ Mo _ eins ___ B6 ___ Do _ vier ___ C6 _ So _ sieben
A7 _ Di _ zwei ___ B7 _ Fr ___ fünf ___ C7 _ Mo _ eins
A8 _ Mi _ drei ___ B8 _ Sa _ sechs ___ C8 _ Di _ zwei
A9 _ Do _ vier ___ B9 _ So _ sieben _ C9 _ Mi _ drei
A10 . Fr _ fünf ___ B10 . Mo _ eins ___ C10 . Do ___ vier
Danke für eure Hilfe
Michael (der Verzweifelnde)
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 = "eins" Then
xRow = rg2.Row
rg2.Offset(1, 1).Value = "zwei"
rg2.Offset(2, 1).Value = "drei"
rg2.Offset(3, 1).Value = "vier"
rg2.Offset(4, 1).Value = "fünf"
rg2.Offset(5, 1).Value = "sechs"
rg2.Offset(6, 1).Value = "sieben"
rg2.Offset(7, 1).Value = "eins"
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