Microsoft Office Forum [ www.Office-Fragen.de ] >> READONLY <<
Microsoft Office 2003-2019 => Excel => Thema gestartet von: ronnerii am Oktober 14, 2012, 10:36:23 Vormittag
-
Hallo,
folgende Ausgangsposition:
2 Spalen A und B mit 13.stelligen Ziffern
In Spalte B sollen keine Werte mehr vorkommen, die auch in Spalte A vorhanden sind, oder anders: Werte die in Spalte A und B vorkommen sollen gelöscht werden.
In der Beispieldatei besteht die 1. Zeile aus doppelten Werten... diese werden aber mit den "normalen" Verfahren "Duplikate entfernen oder über bedingte Formatierung nicht erkannt, bzw. gefunden, obwohl es sich doch eindeutig um identische Werte handelt?!
Vielen Dank für Eure Hilfe!
LG
Ronny
-
Hallo,
Bin zwar alles andere als ein Programmierprofi aber mit dem beigefügten Makrocode (Excel aus Office 07) konnte ich gleichlautende 13-stellige Zahlen löschen, die sich in den Spalten 1 und 2 einer Tabelle befanden.(Ich arbeite immer mit der Z1S1-Notierung, weil man bei der 1A-Notierung in größeren Tabellen schnell die Übersicht verliert). Die Anzahl der Zeilen ist in beiden Spalten beliebig, sofern sie nicht größer ist als 32.767, wenn doch muss man a, c und e nicht als integer sondern als long dimensionieren, also aus dem "%" ein "&" machen.
Sub ZAHLENLÖSCHEN()
'
' ZAHLENLÖSCHEN Makro
'
Dim a%, c%, e%
Dim b As Currency, d As Currency, f As Currency
'letzte Zeile ZL1 in spalte 1 suchen
a = 1
SUCH:
Cells(a, 1).Select
b = ActiveCell
If b <> Empty Then
a = a + 1
GoTo SUCH
End If
ZL1 = a - 1
'letzte Zeile ZL2 in Spalte 2 suchen
a = 1
SUCH2:
Cells(a, 2).Select
b = ActiveCell
If b <> Empty Then
a = a + 1
GoTo SUCH2
End If
ZL2 = a - 1
'Zahlen vergleichen
SUCH4:
c = 1: e = 1
SUCH3:
Cells(c, 1).Select
d = ActiveCell
Cells(e, 2).Select
f = ActiveCell
If d = f Then
'Wenn sie gleich sind, beide Zahlen löschen und ohne sie neu beginnen
Cells(c, 1).Select
Selection.Delete shift:=xlUp
ZL1 = ZL1 - 1
Cells(e, 2).Select
Selection.Delete shift:=xlUp
ZL2 = ZL2 - 1
GoTo SUCH4
End If
'Wenn die Zahlen nicht gleich sind, die zweite Spalte bis zum Ende
'mit dem eingestellten Wert aus Spalte 1 vergleichen
e = e + 1
If e <= ZL2 Then
GoTo SUCH3
End If
'Wenn die Spalte 2 zu Ende verglichen ist, den nächsten Wert aus
'Spalte 1 nehmen und bei der Spalte 2 wieder von oben anfangen
e = 1
c = c + 1
If c <= ZL1 Then
GoTo SUCH3
End If
End Sub
Offensichtlich kommt in der Antwort der Code nicht farbig rüber. Im Original sind die Kommentare, die jeweils mit einem Apostroph beginnen, in grün gehalten. Zur Funktion des Makros brauchst Du solche Zeilen nicht abzutippen.
mfg kealfra