Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
704to708
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
704to708
704to708
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Hilfe bei Codeumstellung

Hilfe bei Codeumstellung
07.12.2005 18:57:14
Jürgen
Hallo zusammen,
folgender Code bewirkt das Auflisten doppelter Einträge im gesamten Tabellenblatt in einem neuen separaten Sheet. Wie kann der Code aussehen, damit nur aus einem markierten Bereich die doppelten Einträge gesucht werden. Z.B nur Spalte A oder B5:C100?
Option Explicit

Sub Listdoubles()
Dim wks As Worksheet
Dim rng As Range
Dim irow As Integer
Set wks = ActiveSheet
Worksheets.Add after:=Worksheets(Worksheets.Count)
For Each rng In wks.UsedRange
If WorksheetFunction.CountIf(wks.UsedRange, rng.Value) > 1 Then
irow = irow + 1
Cells(irow, 1).Value = rng.Value
Cells(irow, 2).Value = rng.Address(False, False)
End If
Next rng
End Sub

Danke für einen Tipp, Jürgen

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Hilfe bei Codeumstellung
07.12.2005 19:18:53
Andi
Hi,
probier mal
For Each rng In Selection
is aber ungetestet...
Schönen Gruß,
Andi
AW: Hilfe bei Codeumstellung
07.12.2005 19:29:44
Jürgen
Hallo Andi,
nee klappt leider nicht. Er erzeugt ein neues aber leeres Tabellenblatt ohne Fehlermeldung.
Gruß Jürgen
AW: Hilfe bei Codeumstellung
07.12.2005 20:07:55
PeterW
Hallo Jürgen,
vom Prinzip her könnte das so funktionieren:

Sub Listdoubles()
Dim wks As Worksheet
Dim rng As Range
Dim irow As Integer
Set wks = ActiveSheet
Worksheets.Add after:=Worksheets(Worksheets.Count)
With ActiveSheet
wks.Select
For Each rng In Selection
If WorksheetFunction.CountIf(Selection, rng.Value) > 1 Then
irow = irow + 1
.Cells(irow, 1).Value = rng.Value
.Cells(irow, 2).Value = rng.Address(False, False)
End If
Next rng
End With
End Sub

Gruß
Peter
Anzeige
AW: Hilfe bei Codeumstellung
07.12.2005 20:34:20
Jürgen
Hallo Peter,
perfekt. Wiedermal hast du mir sehr geholfen.
Danke und Gruß Jürgen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige