| Home | Zur Übersicht |
|
| Thema: Makro um doppelte Einträge zu suchen und zu filtern |
Betrifft: Makro um doppelte Einträge zu suchen und zu filtern
Hallo Zusammen,
Betrifft: Crosspost
Betrifft: AW: Crosspost
Betrifft: AW: Makro um doppelte Einträge zu suchen und zu filtern
Betrifft: AW: Makro um doppelte Einträge zu suchen und zu filtern
Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4 Wenn ja, versuch mal dies: ' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...) ' ********************************************************************** Option Explicit Public Sub test() Dim myDic As Object Set myDic = CreateObject("Scripting.Dictionary") Dim arr As Variant Dim L As Long With Sheets("TAbelle1") .Range("A1").CurrentRegion.Copy arr = Split(Lesen, vbCrLf) For L = LBound(arr) To UBound(arr) myDic(arr(L)) = 0 Next schreiben (Join(myDic.keys, vbCrLf)) .Range("A1").CurrentRegion.Clear .Paste .Range("A1") .Range("A1").Delete shift:=xlToLeft End With End Sub Public Function Lesen() Dim IE As Object On Error Resume Next Set IE = CreateObject("HTMLfile") Lesen = IE.ParentWindow.ClipboardData.GetData("text") Set IE = Nothing End Function Public Sub schreiben(DerText As String) Dim IE As Object Set IE = CreateObject("HTMLfile") IE.ParentWindow.ClipboardData.SetData "text", Chr(32) & DerText & Chr(32) Set IE = Nothing End Sub Ausgabe ist dann dies: Tabelle1
Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4 ransi
Betrifft: AW: Makro um doppelte Einträge zu suchen und zu filtern Sub DelDuplicate()
Dim LastRow As Long
Dim LastCol As Long
Dim x1 As Long, x2 As Long
Dim y1 As String, y2 As String
Dim i As Long, k As Long
'Größe des zusammenhängenden Bereichs feststellen
Cells(1, 1).Select
LastRow = Selection.End(xlDown).Row
Cells(1, 1).Select
LastCol = Selection.End(xlToRight).Column
For i = LastRow To 2 Step -1
x1 = Cells(i, 1).Value
x2 = Cells(i - 1, 1).Value
If x1 = x2 Then
y1 = x1
For k = 2 To LastCol
y1 = y1 & Cells(i, k)
Next k
y2 = x2
For k = 2 To LastCol
y2 = y2 & Cells(i - 1, k)
Next k
If y1 = y2 Then
Range(Cells(i, 1), Cells(i, LastCol)).Delete Shift:=xlUp
End If
End If
Next i
End Sub
Diese Lösung klappt, wenn immer die gleiche Anzahl von Spalten gefüllt sind. Ich sehe aber folgendes Problem: Wenn in Zeile 12 (die 2. Zehner) folgendes steht 10 | 11 | (leer), dann wird zwar die gleiche Zeichenfolge im Vergleichs-String sein aber die beiden Zeilen stimmen dennoch nicht überein. Falls das vorkommen kann, dann verwende diesen Code:Sub DelDuplicate2()
Dim LastRow As Long
Dim LastCol As Long
Dim x1 As Long, x2 As Long
Dim y1 As String, y2 As String
Dim i As Long, k As Long
Cells(1, 1).Select
LastRow = Selection.End(xlDown).Row
Cells(1, 1).Select
LastCol = Selection.End(xlToRight).Column
For i = LastRow To 2 Step -1
x1 = Cells(i, 1).Value
x2 = Cells(i - 1, 1).Value
If x1 = x2 Then
y1 = x1
For k = 2 To LastCol
y1 = y1 & "-" & Cells(i, k)
Next k
y2 = x2
For k = 2 To LastCol
y2 = y2 & "-" & Cells(i - 1, k)
Next k
If y1 = y2 Then
Range(Cells(i, 1), Cells(i, LastCol)).Delete Shift:=xlUp
End If
End If
Next i
End Sub
Wie du den Code in eine Excel-Datei einbindest und danach ausführst, kannst du an verschiedenen Stellen nachlesen.Beste Grüße Drogist
Betrifft: AW: Makro um doppelte Einträge zu suchen und zu filtern
Betrifft: AW: Makro um doppelte Einträge zu suchen und zu filtern Das Einbinden und ausführen deines Codes hat tadellos funktioniert und das gewünschte Ergebnis erzeugt, einfach toll :)Danke. Wenn ich das richtig verstanden habe wandelt dein Code alle Zeilenzeichen in einen String und gleicht dann die Strings aus den Zeilen spaltenweise ab!? (nur eine Verständnisfrage!!!)Jein. :) Also, zur Begrifflichkeit: 1, 2, 3, ... das sind die Zeilen (horizontal) und A, B, C, ... das siche die (vertikalen) Spalten. Ich vergleiche nun zuerst einmal, ob der Wert in Spalte A beispielsweise A10 identisch ist mit der darüber liegenden Zeile gleiche Spalte, hier A9. Wenn die nicht identisch sind, kann der Rest auch nicht identisch sein und A9 wird mit A8 verglichen. Sind die identisch, dann füge ich tatsächlich aus beiden Zeilen alle 3 Spalten einer Zeile zu einem String zusammen und vergleiche die beiden. 1) Wie kann ich den Code anpassen, dass er auch für Kommazahlen funktioniert!? Mein Test war da leider negativ :(Ich habe die Woche über einfach nicht den "Nerv" groß zu testen. Aber versuche einmal, die _ Zeile 4 des Codes um:
Dim x1 As single, x2 As single2) Wie kann ich ihn so erweitern, dass er automatisch für beliebige Zeilen, Spaltenanzahl läuft!? ( Wobei auf jeden Fall immer die gleiche Zeilenanzahl in jeder Spalte vorhanden ist und auch keine Leerzeilen; Zellen vorliegen!)Hmmm, das sollte eigentlich so schon gehen. Dieser Code beginnt in A1 [Cells(1,1)] und sucht von alleine die unterste Zeile des zusammenhängenden Bereichs und auch die äußerst rechte Spalte und legt die Werte in den Variablen LastRow und LastCol fest. 3) Wie kann ich beim Abgleich die ersten beiden Spalten ignorieren, aber beim Zeilenlöschen berücksichtigen, also immer noch ganze zeile löschen (auch in den ersten beiden Zeilen)!? OK, willst du die komplette Zeile löschen oder nur die Spalten A:E? Danach richtet sich die 5. Zeile von unten. - Prinzipiell musst du x1 = Cells(i, 1).Value
x2 = Cells(i - 1, 1).Value
ändern in
x1 = Cells(i, 3).Value
x2 = Cells(i - 1, 3).Value
und das an allen anderen Stellen entsprechend anpassen. Cells(Zeile, Spalte) ist die Syntax. Ungeprüft, versuche einmal diesen Code (komplette Sub): Sub DelDuplicate3()
Dim LastRow As Long
Dim LastCol As Long
Dim x1 As Single, x2 As Single
Dim y1 As String, y2 As String
Dim i As Long, k As Long
'Größe des zusammenhängenden Bereichs feststellen
Cells(1, 1).Select
LastRow = Selection.End(xlDown).Row
Cells(1, 1).Select
LastCol = Selection.End(xlToRight).Column
For i = LastRow To 2 Step -1
x1 = Cells(i, 3).Value
x2 = Cells(i - 1, 3).Value
If x1 = x2 Then
y1 = x1
For k = 4 To LastCol
y1 = y1 & Cells(i, k)
Next k
y2 = x2
For k = 4 To LastCol
y2 = y2 & Cells(i - 1, k)
Next k
If y1 = y2 Then
'Range(Cells(i, 1), Cells(i, LastCol)).Delete Shift:=xlUp
Cells(i, 1).EntireRow.Delete 'Ganze Zeile löschen
End If
End If
Next i
End SubEs sollten also Zeile 9 und 13 komplett gelöscht werden, inklusive Datum( erste Spalte) und Indikator (zweite Spalte). Das sollte dann auch hinhauen ... LG Drogist
Betrifft: AW: Makro um doppelte Einträge zu suchen und zu filtern
Betrifft: AW: Makro um doppelte Einträge zu suchen und zu filtern
|
