Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
996to1000
996to1000
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Doppelte anlisten

Forumthread: Doppelte anlisten

Doppelte anlisten
05.08.2008 11:05:00
Petra
Schönen Tag allerseits
Thema ist bestimmt schon oft durchgekaut, habe aber trotzdem nichts passendes gefunden.
Ich habe eine Tabelle (ca. 10.000 Zeilen), in einer Spalte sind Materialnummern (60 stellig). Folgendes Makro funktioniert nicht, da Excel die Nummern (obwohl als Text formatiert) als Zahl interpretiert.

Sub DoppelteRaus()
Application.EnableEvents = False
Dim i As Integer, iRows As Integer, d
d = 2
iRows = Cells(Cells.Rows.Count, 19).End(xlUp).Row
For i = iRows To 1 Step -1
If WorksheetFunction.CountIf(Columns(19), Cells(i, 19)) > 1 Then
Sheets("Prüflist").Cells(d, 3).Hyperlinks.Add Anchor:=Sheets("Prüflist"). _
Cells(d, 3), _
Address:="", SubAddress:="Tabelle1!" & Cells(i, 8).Address,  _
TextToDisplay:="Tabelle1!" & Cells(i, 8).Address
d = d + 1
End If
Next i
Application.EnableEvents = True
End Sub


wie muß ich das Makro anpassen, das das Makro die Zahlenreihen als Text interpretiert?
Liebe Grüße
Petra

Anzeige

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Doppelte anlisten
05.08.2008 11:27:01
Daniel
Hi
das Problem ist, daß die CountIF-Funktion immer versucht, Texte wenn möglich in Zahlen umzuwandeln.
nur leider ist bei Excel nach 15 stellen schluss, danach wird gerundet.
mögliche Abhilfe wären folgende:
1. du versiehst alle Materialnummern mit einen alphabetischen Zeichen oder dem Unterstrich, dann kann CountIF den Text nicht mehr in eine Zahl umwandeln und arbeitet richtig.
2. du sortierst deine Daten vorab nach der Materialnummer, dann kannst du die Doppelten durch einen Einfachen Vergleich mit der Zelle drüber und der Zelle drunter rausfinden.
das dürfte bei 10.000 Zeilen die Peformance des Makros auch deutlich verbessern, da die CountIF-Funktion sehr zeitintensiv ist.
(so als rechenbeispiel: die CountIf Funtkiton vergleicht den Wert mit allen Werten der Spalte, dh. wenn du alle Zeilen durchnudelst, hast du 10.000 x 10.000 Zellvergleiche, dh 100.000.000.
bei sortierten Daten musst du pro Schleifendurchlauf nur 2 Vergleiche durchführen, dh. du kommst auf 20.000 Zellvergleiche.)
Gruß, Daniel

Anzeige
AW: Doppelte anlisten
05.08.2008 12:28:00
Petra
Hi Daniel
danke für Deinen Beitrag.
Zu 1. an das habe ich auch schon gedacht, bräuchte dann aber eine Hilfsspalte (oder?)
zu 2. geht nicht, da ich nicht sortieren kann, da die Liste immer in der gleichen Form(Aufbau) sein muß
Ich lasse mal den Beitrag auf offen stehen und hoffe auf weitere Tipps
Grüße Petra

Anzeige
AW: Doppelte anlisten
05.08.2008 13:12:12
Daniel
Hi
Hilfsspalten sind sowieso meistens hilfreich ;-).
allerdings würd ich mal nachprüfen, warum die Liste nicht sortiert werden darf, das lässt bei einer Liste dieser Grösse immer auf schlechte EDV-Planung (oder gewachsene Datenstrukturen) schließen
durch die Sortierung wird ja im Prinzip an der Datenstruktur nichts verändert.
im Zeifelsfall muss man sich halt die Original-Sortierung in einer Hilfsspalte sichern und dann wieder zurücksortieren (wenn es innerhalb der Daten keinen Sortierschlüssel gibt).
Die Hilfsspalte kann dann gelöscht werden.
die ZählenWenn(CountIF)-Lösung würde aber meiner Ansicht nach schon aus Performace-Gründen rausfallen.
das hin- und her- Sortieren erledigt in Nullkommanix (fast zumindest)
Gruß, Daniel

Anzeige
AW: Doppelte anlisten
05.08.2008 13:13:00
Rudi
Hallo,
solange die MatNr als 60stellige Texte vorliegen:

Sub DoppelteRaus()
Application.EnableEvents = False
Dim i As Long, iRows As Long, d, vntTest, j As Long, iCounter As Long
d = 2
iRows = Cells(Cells.Rows.Count, 19).End(xlUp).Row
vntTest = Range(Cells(1, 19), Cells(iRows, 19))
vntTest = WorksheetFunction.Transpose(vntTest)
For i = 1 To iRows
iCounter = 0
For j = 1 To iRows
If vntTest(i) = vntTest(j) Then iCounter = iCounter + 1
If iCounter > 1 Then Exit For
Next j
If iCounter > 1 Then
Sheets("Prüflist").Cells(d, 3).Hyperlinks.Add Anchor:=Sheets("Prüflist"). _
Cells(d, 3), Address:="", SubAddress:="Tabelle1!" & Cells(i, 8).Address, _
TextToDisplay:="Tabelle1!" & Cells(i, 8).Address
d = d + 1
End If
Next i
Application.EnableEvents = True
End Sub


Gruß
Rudi

Anzeige
AW: Doppelte anlisten, Korrektur
05.08.2008 13:16:12
Rudi
kleine Korrektur:
For j = i+1 To iRows
Gruß
Rudi

AW: Doppelte anlisten, Korrektur
05.08.2008 13:24:52
Petra
Hallo Rudi
klappt ja wunderbar! Nur ein kleines Problem habe ich noch (habs leider vergessen, zu erwähnen), es sind auch noch etliche Zellen mit BLANK (nix drin) und die sollte das Makro natürlich nicht mit ausweisen.
Ist da noch was zu machen?
Liebe Grüße
Petra

Anzeige
AW: Doppelte anlisten, Korrektur
05.08.2008 13:31:00
Rudi
Hallo,
kein Problem.

Sub DoppelteRaus()
Application.EnableEvents = False
Dim i As Long, j As Long, iRows As Long, d As Long, vntTest, iCounter As Long
d = 2
iRows = Cells(Cells.Rows.Count, 19).End(xlUp).Row
vntTest = Range(Cells(1, 19), Cells(iRows, 19))
vntTest = WorksheetFunction.Transpose(vntTest)
For i = 1 To iRows
If vntTest(i)  "" Then
iCounter = 0
For j = i + 1 To iRows
If vntTest(i) = vntTest(j) Then iCounter = iCounter + 1
If iCounter > 1 Then Exit For
Next j
If iCounter > 1 Then
Sheets("Prüflist").Cells(d, 3).Hyperlinks.Add Anchor:=Sheets("Prüflist"). _
Cells(d, 3), Address:="", SubAddress:="Tabelle1!" & Cells(i, 8).Address, _
TextToDisplay:="Tabelle1!" & Cells(i, 8).Address
d = d + 1
End If
End If
Next i
Application.EnableEvents = True
End Sub


Gruß
Rudi

Anzeige
AW: Doppelte anlisten, Korrektur
05.08.2008 13:40:12
Petra
Danke Rudi und einen schönen Tag noch
Gruß Petra

AW: kleine Nachfrager
05.08.2008 14:20:23
Daniel
Hi
mal ne Frage, bei 1000 Zeilen, wie lange läuft denn das Makro bei dir?
Gruß, Daniel

AW: kleine Nachfrager
05.08.2008 14:26:00
Petra
Hi Daniel
auch nicht schneller, nur man spart sich die Hilfsspalte
Liebe Grüße Petra

Anzeige
AW: kleine Nachfrager
05.08.2008 15:59:14
Daniel
Hi
mit den Hyperlinks ist das natürlich schwierig, das verbietet natürlich das umsortieren.
da würde aber lieber die Werte der Doppelten in ein neues Blatt kopieren und dann ein kleines Makro,daß beim Anklicken den Autofilter entsprechend im Tabellenblatt setzt.
dann Fallen die Hyperlinks weg (ich finde die sowieso meist lästig)
aber auch wenn du Hyperlinks haben willst, kann man da u.U. schneller gestalten.
probier mal das Makro hier aus, ich konnte es mangels Daten leider nicht testen.
Funktionsweise ist so:
- orginalreihenfolge sichern
- daten Sortieren
- Doppelte Finden
- original-ZeilenNr der Doppelten in Prüfliste Schreiben
- Daten wieder zurücksortiern in alte Reihenfolge
- in Prüfliste Hyperlinks erstellen.
probiers mal aus, wenn nicht das erstellen der Hyperlinks der Zeitfresser ist, dann sollte das hier deutlich schneller sein.
Gruß, Daniel

Sub TestDoppelte()
Dim sp As Long, ze As Long
Dim Zelle As Range
With Sheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell)
sp = .Column + 1
ze = .Row
End With
With Sheets("Tabelle1")
'--- Originalreihenfolge sichern
With Range(.Cells(1, sp), .Cells(ze, sp))
.FormulaLocal = "=Zeile()"
.Formula = .Value
End With
'--- Doppelte finden
With Range(.Cells(2, sp + 1), .Cells(ze, sp + 1))
.FormulaLocal = "=WENN(S2="""";ZEILE();WENN(ODER(S2=S1;S2=S3);"""";ZEILE()))"
.Formula = .Value
.EntireRow.Sort , key1:=Cells(2, sp + 1), header:=xlNo
.SpecialCells(xlCellTypeBlanks).Offset(0, -1).Copy _
Destination:=Sheets("Prüflist").Range("C2")
End With
'--- Zurücksortieren
.UsedRange.Sort key1:=.Cells(1, sp), oder1:=xlAscending, header:=xlNo
.Columns(sp).Resize(, 2).Delete
End With
'--- Hyperlinks erzeugen
With Sheets("Prüflist")
Set Zelle = .Range("C2")
Do Until Zelle.Value = ""
ze = Zelle.Value
Zelle.Clear
.Hyperlinks.Add Anchor:=Zelle, Address:="", _
SubAddress:="Tabelle1!" & Cells(ze, 8).Address, _
TextToDisplay:="Tabelle1!" & Cells(ze, 8).Address
Loop
End With
End Sub


Anzeige
AW: kleine Nachfrager
05.08.2008 16:15:00
Petra
Hi Daniel
erst mal DANKE, aber nicht böse sein, für mich ist für Heute FEIERABEND. Morgen wieder!
Bis dann und einen schönen Feierabend auch für Dich
Petra
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige