Hey!
Folgendes Problem: Ich will, dass mein makro alle Zellen in der Spalte A überprüft, so bald irgendwo etwas doppelt vorkommt, soll die ganze zeile gelöscht werden, davor aber der inhalt aus Spalte C von den jeweiligen doppelten Zeilen (die dann gelöscht werden) 5 Spalten weiter rechts in eine einzige Zelle (die aus der Zeile, die nur einmal vorkommt) eingefügt wird.
N bisschen unverständlich geschrieben, aber ich weiss nich wie ichs sonst beschreiben soll, vielleicht hier nochmal was ich bis jetzt hab:
Sub DoppelteSätzeRauswerfen()
Dim CompareRange As Variant, x As Variant, y As Variant
Set CompareRange = Range("A1")
Dim Range1 As Variant, z As Variant
Set Range1 = Range("C1:C5")
Set z = Range1
For Each x In CompareRange
For Each y In CompareRange
For Each z In Range1
If x = y Then z.Offset(, 5) = z
Next z
Next y
Next x
Range("A1").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub
Vielen vielen Dank, wenn ihr mir irgendwie helfen könnt!!! lg Marie
Folgendes Problem: Ich will, dass mein makro alle Zellen in der Spalte A überprüft, so bald irgendwo etwas doppelt vorkommt, soll die ganze zeile gelöscht werden, davor aber der inhalt aus Spalte C von den jeweiligen doppelten Zeilen (die dann gelöscht werden) 5 Spalten weiter rechts in eine einzige Zelle (die aus der Zeile, die nur einmal vorkommt) eingefügt wird.
N bisschen unverständlich geschrieben, aber ich weiss nich wie ichs sonst beschreiben soll, vielleicht hier nochmal was ich bis jetzt hab:
Sub DoppelteSätzeRauswerfen()
Dim CompareRange As Variant, x As Variant, y As Variant
Set CompareRange = Range("A1")
Dim Range1 As Variant, z As Variant
Set Range1 = Range("C1:C5")
Set z = Range1
For Each x In CompareRange
For Each y In CompareRange
For Each z In Range1
If x = y Then z.Offset(, 5) = z
Next z
Next y
Next x
Range("A1").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub
Vielen vielen Dank, wenn ihr mir irgendwie helfen könnt!!! lg Marie
Comment