Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
804to808
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
804to808
804to808
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

doppelte Zahlen finden - rausschreiben

doppelte Zahlen finden - rausschreiben
04.10.2006 13:10:01
ticonhh
Hallo liebes Forum,
habe ein Problem mit dem u.g. Code. Möchte doppelte Einträge löschen und in eine
Spalte kopieren. Klappt leider nicht.
Public

Sub FilterDuplicatesF()
Dim wkbDataa     As Workbook
Dim wksDataa    As Worksheet
Dim wksDataNeww  As Worksheet
Dim rngDataa     As Range
Dim nColsCntt    As Integer
Dim nRowsCntt    As Long
Application.ScreenUpdating = False
Set wkbDataa = ThisWorkbook
Set wksDataa = wkbDataa.Worksheets(3)
Set wksDataNeww = ThisWorkbook.Worksheets(4)
With wksDataa
Set rngDataa = _
.Range(.Cells(3, 11), .Cells(500, 11))
End With
wksDataNeww.Range("a1:a2000").Clear
rngDataa.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=wksDataNeww.Range("a1"), Unique:=True
Application.ScreenUpdating = True
Set rngDataa = Nothing
Set wksDataNeww = Nothing
Set wksDataa = Nothing
End Sub

Dank für Eure Hilfe.
Gruss ticonhh

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: doppelte Zahlen finden - rausschreiben
04.10.2006 13:56:07
Rudi
Hallo,
hast du das
rngDataa.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=wksDataNeww.Range("a1"), Unique:=True
mal 'von Hand' probiert? Mach mal!
Gruß
Rudi
AW: doppelte Zahlen finden - rausschreiben
04.10.2006 14:37:29
fcs
Hallo ticon,
evtl. bringt dich folgende Anpassung der Lösung etwas näher.
Gruß
Franz

Sub FilterDuplicatesF()
Dim wkbDataa     As Workbook
Dim wksDataa    As Worksheet
Dim wksDataNeww  As Worksheet
Dim rngDataa     As Range
Dim rngFinden As Range
Dim nZeileNew As Long, nZeile As Long
Dim nColsCntt    As Integer
Dim nRowsCntt    As Long
Application.ScreenUpdating = False
Set wkbDataa = ThisWorkbook
Set wksDataa = wkbDataa.Worksheets(3)
Set wksDataNeww = ThisWorkbook.Worksheets(4)
wksDataNeww.Range("a1:a2000").Clear
nZeileNew = 1
With wksDataa
nRowsCntt = .Cells(.Rows.Count, 11).End(xlUp).Row
For nZeile = 3 To nRowsCntt - 1
If Not IsEmpty(.Cells(nZeile, 11)) Then
Set rngDataa = .Range(.Cells(nZeile + 1, 11), .Cells(nRowsCntt, 11))
Set rngFinden = rngDataa.Find(What:=.Cells(nZeile, 11), LookIn:=xlValues, Lookat:=xlWhole)
Do Until rngFinden Is Nothing
'Doppelten Wert in neue Tabelle übertragen
wksDataNeww.Cells(nZeileNew, 1).Value = rngFinden.Value
'Doppelten Eintrag Löschen
rngFinden.ClearContents
nZeileNew = nZeileNew + 1
Set rngFinden = rngDataa.FindNext
Loop
End If
Next
End With
Application.ScreenUpdating = True
Set rngDataa = Nothing
Set wksDataNeww = Nothing
Set wksDataa = Nothing
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige