nach doppelten e-mail Adressen suchen



Excel-Version: 97
nach unten

Betrifft: nach doppelten e-mail Adressen suchen
von: Dino
Geschrieben am: 05.05.2002 - 19:34:04

Hi Leute,

ich habe viele e-mail Adressen ca. 10000 in Splate A, jetzt möchte ich nach doppelten e-mail Adressen suchen, die doppelte e-mail sollen aus Spalte A ausgetragen und in Tabelle 2 Spalte A eingetragen werden. Wenn ich nächtes Mal das Makro ausführe, sollen die doppelte e-mails auch in Tabelle 2 Spalte A eingetragen werden, ohne die alte zu überschreiben (einfach in nächste leere Zelle in Spalte A).

Vielen Dank im voraus....

Dino


nach oben   nach unten

Re: nach doppelten e-mail Adressen suchen
von: WernerB.
Geschrieben am: 05.05.2002 - 20:13:59

Hallo Dino,

wie gefällt Dir dies (von den "Doppelten" verbleibt jeweils ein Exemplar in "Tabelle1"):


Option Explicit
Sub DoppEmailAdr()
Dim tbQ As Worksheet, tbZ As Worksheet
Dim SuBe As String
Dim As Range
Dim laRQ As Long, laRZ As Long, acR As Long
    Application.ScreenUpdating = False
    Set tbQ = ThisWorkbook.Sheets("Tabelle1")
    Set tbZ = ThisWorkbook.Sheets("Tabelle2")
    laRQ = tbQ.Cells(Rows.Count, 1).End(xlUp).Row
    SuBe = "A1:A" & laRQ
    For Each c In tbQ.Range(SuBe)
      If WorksheetFunction.CountIf(Range(SuBe), c.Value) > 1 Then
        acR = c.Row
        With tbZ
          laRZ = tbZ.Cells(Rows.Count, 1).End(xlUp).Row
          If laRZ = 1 And IsEmpty(tbZ.Cells(1, 1)) Then laRZ = 0
          .Cells(laRZ + 1, 1).Value = tbQ.Cells(acR, 1).Value
        End With
        c.ClearContents
      End If
    Next c
    Application.ScreenUpdating = True
End Sub

Viel Erfolg wünscht
WernerB.
nach oben   nach unten

Re: nach doppelten e-mail Adressen suchen
von: Dino
Geschrieben am: 05.05.2002 - 22:16:29

Hallo Werner,

superrrrr :))

jetzt nur noch eine Frage, kann man das MAkro erweitern so das leere Zeilen in Tabelle1 gelöscht werden nach dem Makro ausgeführt ist.

Nochmal vielen Dank....

Gruß
Dino

nach oben   nach unten

Re: nach doppelten e-mail Adressen suchen
von: WernerB.
Geschrieben am: 05.05.2002 - 22:30:46

Hallo Dino,

no Problem:


Option Explicit
Sub DoppEmailAdr()
Dim tbQ As Worksheet, tbZ As Worksheet
Dim SuBe As String
Dim As Range
Dim laRQ As Long, laRZ As Long, acR As Long, i As Long
    Application.ScreenUpdating = False
    Set tbQ = ThisWorkbook.Sheets("Tabelle1")
    Set tbZ = ThisWorkbook.Sheets("Tabelle2")
    laRQ = tbQ.Cells(Rows.Count, 1).End(xlUp).Row
    SuBe = "A1:A" & laRQ
    For Each c In tbQ.Range(SuBe)
      If WorksheetFunction.CountIf(Range(SuBe), c.Value) > 1 Then
        acR = c.Row
        With tbZ
          laRZ = .Cells(Rows.Count, 1).End(xlUp).Row
          If laRZ = 1 And IsEmpty(.Cells(1, 1)) Then laRZ = 0
          .Cells(laRZ + 1, 1).Value = tbQ.Cells(acR, 1).Value
        End With
        c.ClearContents
      End If
    Next c
    For i = laRQ To Step -1
      If IsEmpty(tbQ.Cells(i, 1)) Then _
        tbQ.Cells(i, 1).Delete Shift:=xlUp
    Next i
    Application.ScreenUpdating = True
End Sub

Viel Erfolg wünscht
WernerB.
nach oben   nach unten

Re: nach doppelten e-mail Adressen suchen
von: Dino
Geschrieben am: 09.05.2002 - 21:25:50

Ich bedanke mich nochmal für Deine Hilfe...

Gruß
Dino


 nach oben

Beiträge aus den Excel-Beispielen zum Thema "nach doppelten e-mail Adressen suchen "