Microsoft Excel

Herbers Excel/VBA-Archiv

Doppelte anlisten

Betrifft: Doppelte anlisten von: Petra
Geschrieben am: 05.08.2008 11:05:07

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

  

Betrifft: AW: Doppelte anlisten von: Daniel
Geschrieben am: 05.08.2008 11:27:01

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


  

Betrifft: AW: Doppelte anlisten von: Petra
Geschrieben am: 05.08.2008 12:28:14

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


  

Betrifft: AW: Doppelte anlisten von: Daniel
Geschrieben am: 05.08.2008 13:12:12

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


  

Betrifft: AW: Doppelte anlisten von: Rudi Maintaire
Geschrieben am: 05.08.2008 13:13:22

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


  

Betrifft: AW: Doppelte anlisten, Korrektur von: Rudi Maintaire
Geschrieben am: 05.08.2008 13:16:12

kleine Korrektur:

For j = i+1 To iRows

Gruß
Rudi


  

Betrifft: AW: Doppelte anlisten, Korrektur von: Petra
Geschrieben am: 05.08.2008 13:24:52

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


  

Betrifft: AW: Doppelte anlisten, Korrektur von: Rudi Maintaire
Geschrieben am: 05.08.2008 13:31:43

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


  

Betrifft: AW: Doppelte anlisten, Korrektur von: Petra
Geschrieben am: 05.08.2008 13:40:12

Danke Rudi und einen schönen Tag noch
Gruß Petra


  

Betrifft: AW: kleine Nachfrager von: Daniel
Geschrieben am: 05.08.2008 14:20:23

Hi
mal ne Frage, bei 1000 Zeilen, wie lange läuft denn das Makro bei dir?
Gruß, Daniel


  

Betrifft: AW: kleine Nachfrager von: Petra
Geschrieben am: 05.08.2008 14:26:41

Hi Daniel
auch nicht schneller, nur man spart sich die Hilfsspalte
Liebe Grüße Petra


  

Betrifft: AW: kleine Nachfrager von: Daniel
Geschrieben am: 05.08.2008 15:59:14

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




  

Betrifft: AW: kleine Nachfrager von: Petra
Geschrieben am: 05.08.2008 16:15:24

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


 

Beiträge aus den Excel-Beispielen zum Thema "Doppelte anlisten"