Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
212to216
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
212to216
212to216
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

doppelte löschen

doppelte löschen
03.02.2003 23:31:30
ivan
hi liebe gemeinde
ich brauche einen fertigen code der mir doppelte einträge in tabelle3,spalte g,h,i löscht.habe schon viele beiträge gelesen aber ich finde keinen.am einfachsten wäre ja der spezialfilter
aber das funkt nicht weil ich hyperlinks in spalte g habe und die werden nicht mit kopiert.also muß ich die ganze zeile löschen.
hat jemand schon einen fertigen code für mich oder einen wo ich die spalten nur anpassen kann???
danke
ivan

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: doppelte löschen
04.02.2003 00:00:23
Nepumuk

Hallo Ivan,
sollen nur die doppelten Einträge gelöscht werden oder auch die Zellen in denen sie sich befinden?
Gruß
Nepumuk


Re: doppelte löschen
04.02.2003 00:10:27
ivan

hi nepumuk
ist mir egal!
das was schneller ist wegen dem code der ist eh schon so lang.
DANKE
IVAN

Re: doppelte löschen
04.02.2003 01:34:25
Nepumuk

Hallo Ivan,
dann dürfte das am schnellsten laufen.

Option Explicit
Option Base 1
Public Sub doppelte_loeschen()
Dim zeile As Long, spalte As Integer, Zelle As Range, Adresse As String
Dim Zaehler As Long, index As Long, Merkerfeld() As String
Application.ScreenUpdating = False
With Sheets("Tabelle3")
For spalte = 7 To 9
For zeile = .Range(Chr(64 + spalte) & "65536").End(xlUp).Row To 1 Step -1
If .Cells(zeile, spalte).Value <> "" Then
Set Zelle = .Range("G1:I65536").Find(What:=.Cells(zeile, spalte), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
If Not Zelle Is Nothing Then
Zaehler = 0
ReDim Merkerfeld(1)
Adresse = Zelle.Address
Do
Zaehler = Zaehler + 1
ReDim Preserve Merkerfeld(1 To Zaehler)
Merkerfeld(Zaehler) = Zelle.Address
Set Zelle = .Range("G1:I65536").FindNext(Zelle)
Loop While Not Zelle Is Nothing And Zelle.Address <> Adresse
End If
For index = 2 To UBound(Merkerfeld)
.Range(Merkerfeld(index)) = ""
Next
End If
Next
Next
End With
Application.ScreenUpdating = True
End Sub

Gruß
Nepumuk

Anzeige
Re: doppelte löschen
04.02.2003 12:40:50
ivan


hallo nepumuk

wir sind ganz nahe dran nur löscht er jetzt
ungewollt interpreten
oder songtitel die doppelt sind!!
das ist der code der mir alles nach tabelle3 kopiert
und anschließend folgt dein code.

Private Sub CommandButton1_Click()
Sheets("Tabelle3").Activate
k = 6
For i = 0 To UserForm1.ListBox3.ListCount - 1
If UserForm1.ListBox3.Selected(i) = True Then
For k = 6 To 8
k = k + 1
link = ListBox3.List(i)
j = Cells(Rows.Count, k).End(xlUp).Row + 1
Worksheets("tabelle1").Cells(i + 1, k - 4).Copy
Worksheets("tabelle3").Activate
Cells(j, k).Activate
ActiveCell.PasteSpecial
Next k
End If
Next i
          
 'löscht doppelte einträge in tabelle3
    Call doppelte_loeschen
 End Sub 

Beispiel:1
   G:    H:  I: Spalten 
Frenando 1 Abba 'wenn ich gleiche interpreten kopiere
SoS      2 Abba

ergebniss:1
Frenando 1 Abba
SoS      2 

Beispiel: 2 'wenn ich gleiche songnamen kopiere   
Angel    1 Lionel Richie
Angel    2 Robbi Williams
Angel    3 Shaggy

ergebniss:2
Angel    1 Lionel Richie
         2 Robbi Williams
         3 Shaggy

kann man so was überhaupt lösen??
bin verzweifelt,so ein toller code,und stimmt trotzdem nicht,
HOFFENTLICH HAST DU EINE IDEE FÜR MICH 
DANKE
IVAN

   
 

     Code eingefügt mit Syntaxhighlighter 1.16



Anzeige
Re: doppelte löschen
04.02.2003 14:16:13
Nepumuk

Hallo Ivan,
das hättest du aber auch gleich schreiben können, das die Daten in den Spalten nicht unabhängig voneinander sind. Das macht einen anderen Ansatz notwendig. Ich melde mich Morgen wieder.
Gruß
Nepumuk

Re: doppelte löschen
04.02.2003 14:56:55
ivan

hi
sorry an das hab ich gar nicht gedacht.das hat sich für mich erst nach dem code herausgestellt.
danke
bis morgen
ivan

Re: doppelte löschen
06.02.2003 08:26:36
Nepumuk

Hallo Ivan,
dein Programm:

Option Explicit
Option Base 1
Option Private Module
Option Compare Text
Dim feld1() As String, feld2() As String, feld3() As String
Public Sub doppelte_loeschen()
Dim zeile As Long, zaehler As Long, geloescht As Long, feld4() As String, leoschstring As String
With Sheets("Tabelle3")
For zeile = 1 To .Range("G65536").End(xlUp).Row
If .Cells(zeile, 7) <> "" Then
zaehler = zaehler + 1
ReDim Preserve feld1(1 To zaehler)
ReDim Preserve feld2(1 To zaehler)
ReDim Preserve feld3(1 To zaehler)
feld1(zaehler) = .Cells(zeile, 7)
feld2(zaehler) = .Cells(zeile, 9)
feld3(zaehler) = zeile
End If
Next
If zaehler > 0 Then
Call sortieren(1, zaehler)
For zeile = zaehler To 2 Step -1
If LCase(feld1(zeile)) = LCase(feld1(zeile - 1)) And LCase(feld2(zeile)) = LCase(feld2(zeile - 1)) Then
geloescht = geloescht + 1
ReDim Preserve feld4(1 To geloescht)
feld4(geloescht) = feld3(zeile - 1)
End If
Next
For zeile = 1 To geloescht
leoschstring = leoschstring & ",G" & feld4(zeile) & ":I" & feld4(zeile)
Next
If geloescht > 0 Then
leoschstring = Mid(leoschstring, 2)
.Range(leoschstring).Delete Shift:=xlUp
End If
End If
End With
End Sub
Private Sub sortieren(Untergrenze As Long, Obergrenze As Long)
Dim index1 As Long, index2 As Long, Element1 As String, Element2 As String
Dim Element3 As String, Zwischenspeicher As Variant
index1 = Untergrenze
index2 = Obergrenze
Zwischenspeicher = feld1(((Untergrenze + Obergrenze) / 2) \ 1) & feld2(((Untergrenze + Obergrenze) / 2) \ 1)
Do
Do While feld1(index1) & feld2(index1) < Zwischenspeicher
index1 = index1 + 1
Loop
Do While Zwischenspeicher < feld1(index2) & feld2(index2)
index2 = index2 - 1
Loop
If index1 <= index2 Then
Element1 = feld1(index1)
Element2 = feld2(index1)
Element3 = feld3(index1)
feld1(index1) = feld1(index2)
feld2(index1) = feld2(index2)
feld3(index1) = feld3(index2)
feld1(index2) = Element1
feld2(index2) = Element2
feld3(index2) = Element3
index1 = index1 + 1
index2 = index2 - 1
End If
Loop Until index1 > index2
If Untergrenze < index2 Then Call sortieren(Untergrenze, index2)
If index1 < Obergrenze Then Call sortieren(index1, Obergrenze)
End Sub

Gruß
Nepumuk

Anzeige
Re: doppelte löschen
06.02.2003 09:27:31
ivan

hi
danke vielmals ich werd es gleich probieren!!
soll ich das in die userform direkt oder ein klassenmodul

weil nach dem ersten kopieren in die userform ist das hier rot
Option Private Module????
IVAN

Re: Du bist ein genie Danke
06.02.2003 10:17:16
ivan

hi
alles roger genial!
es funkt so gut ohne fehler,das ich es momentan gar nicht gemerkt habe das es funkt, weil es so schnell ist .
als dank bekommast du die vollversion vom mp3 reader 2.0!
sag mir wohinn ich sie dir schicken soll.
vielen dank
ivan

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige