Moin Moin,
wow! Noch nicht einmal eine Stunde! Wenn das nicht schnell ist. Vielen Dank!
Jetzt musste ich leider (wieder) einmal merken, dass Makros nicht meine Muttersprache sind ;-(
Ich brauche noch einmal deine/eure Hilfe. Und zwar habe ich einen bestehenden Quellcode und an der markierten Stelle sollte der für die X67 usw. rein.
Nur, nachdem ich den Code von nighty angeguckt habe, weiß ich nicht so recht, wie ich den da einfüge.
Ich poste einfach mal meinen bisherigen Code und
HIER findet ihr auch eine passende Beispieldatei.
Alle Felder die jeweils zusammengehören, also von dem Makro zusammengeführt werden sollen, sind farbig markiert.
Wie ihr auch seht, war das mit den X67 nicht das einzige, was das Makro machen soll.
Im Übrigen stehen die Zahlen für die Wochentage (1=MO,2=DI) und das D steht für täglich, das X für außer an den nachfolgenden Tagen (z.B. X67 heißt außer am Wochenende). Vielleicht erklärt
das ja so ein bissl den Zusammenhang.
Was ich damals vergessen habe: Werden hinter dem X alle Zahlen gelöscht, muss dann natürlich ein D für täglich stehen. (in der Beispielsdatei das grau hinterlegte Paar).
Hier nun der Code, sonst rede ich noch mehr wirres Zeug. Bei Fragen, gerne- versuche ich zu beantworten. Mir ist im Übrigen bewusst, dass man einiges schöner hätte ausdrücken können, aber es erfüllt seinen Zweck:
Sub zusammenfuehren()
Dim inhalt, zeichen As String
zahl = 1
bzahl = 2
Do While zahl < 5000
If Cells(zahl, 1).Value <> "" Then
Do While bzahl < 5000
If Cells(bzahl, 1).Value <> "" Then
If Cells(zahl, 1).Value = Cells(bzahl, 1).Value Then
If Cells(zahl, 8).Value = Cells(bzahl, 8).Value Then
'richtig anordnen
Z = Cells(zahl, 2)
u = Cells(bzahl, 2)
If Mid(Z, 1, 1) <> "X" Then
If Mid(u, 1, 1) <> "X" Then
neueri = Cells(bzahl, 2) & Cells(zahl, 2)
y = neueri
For j = 1 To 7
For i = 1 To Len(y)
zeichen = Mid(y, i, 1)
Select Case zeichen
Case j
inhalt = inhalt & j
End Select
Next i
Next j
If inhalt = 12345 Then
inhalt = "X67"
End If
If inhalt = 123456 Then
inhalt = "X7"
End If
If inhalt = 123457 Then
inhalt = "X6"
End If
If inhalt = 1234567 Then
inhalt = "D"
End If
' falls X
Else
'HIER KOMMT DAS ERSTE X67 REIN!!!!
End If
Else
'HIER KOMMT DAS ZWEITE X67 REIN!!!!
End If
Cells(zahl, 2).Value = inhalt
inhalt = ""
Rows(bzahl & ":" & bzahl).Delete
Else
bzahl = bzahl + 1
End If
Else
bzahl = bzahl + 1
End If
Else
bzahl = 9999
End If
Loop
zahl = zahl + 1
bzahl = zahl + 1
Else
zahl = 9999
End If
Loop
End Sub
Vielen Dank auf jeden Fall! Ihr seid echt Gold wert!
Schönes Wochenende schon einmal
rapperzahn
