Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Code verbessern: Doppelte Einträge leeren





Frage

Hi, ich habe hier folgendes: [code]Sub DoppEintraegeEntf() On Error GoTo ErrorHandler MousePointer = fmMousePointerHourGlass 'Ändere Mauszeiger Application.ScreenUpdating = False 'Bildschirmanzeige nicht updaten '---> Eigentlicher Code Dim vRange As Variant Dim c As Variant Dim lCounter As Long lCounter = 0 Set vRange = Selection.Cells For c = vRange.Cells.Count To 1 Step -1 If Application.CountIf(vRange, vRange(c)) <> 1 Then vRange(c).Value = "" lCounter = lCounter + 1 Else End If Next c Application.ScreenUpdating = True MsgBox lCounter & " Zelleinträge gelöscht.", 64 '<--- ExitScript: MousePointer = fmMousePointerDefault 'Mauszeiger wieder Standard Application.ScreenUpdating = True Exit Sub ErrorHandler: MsgBox "Es ist ein Fehler aufgetreten." & Chr(10) & Chr(10) _ & "Fehlermeldung: " & Error$ & Chr(10) _ & "Fehlernummer: " & Err & Chr(10) _ , 64, "Error" Resume ExitScript End Sub[/code] Was passiert: In einer Range (also ausgewählte Zellen) lasse ich alle doppelten Zellen leeren (""). Problem: Angenommen User markiert Spalte A, dann durchläuft die For..Next - Schleife alle 65k Zellen, und das ist tötlich bei Count To 1 Step -1. Any Idea, wie ich das optimieren könnte? Logic

Antwort 1 von Guenter

Hallo,

versuche mal folgende Änderung:


...
 Set vRange = Selection.Cells.End(xlDown)
    For c = vRange To 1 Step -1
...


Statt einer guten Errorhandling würde ich versuchen herauszufinden, wo die Fehlerursachen liegen und diese dann im Program entsprechend zu ändern versuchen.
Beispiel:

...
If Selection Is Nothing Then Exit Sub
...



Gruß
Günter

Antwort 2 von logic

Günter,

Durch diese Änderung werden leider nicht alle doppelten Zellen gelöscht.


Zitat:
Statt einer guten Errorhandling...

Das ist Errorhandling was Du da schreibst :-)

Wie man dies abhandelt ist Stilfrage und/oder kommt auch auf den jew. Fall an. D.h. dann entweder über GoTo zum Errorhandler springen und dort über Select Case die einzelnen Errors abzufangen, oder direkt. Und auch individuell. Ich denke meist sinvoll ist die Kombination beider (und kann nicht verallgemeinert werden).

Logic

Antwort 3 von Guenter

Hallo,

nochmal zu dem Makro:
ich habe nicht getestet, ob die doppelten Zellen gelöscht werden.
Die von mir geschriebene Änderung bewirkt nur, dass nicht alle Zellen einer Spalte durchlaufen werden, also nicht bis 65k sondern nur zur letzten.
Vielleicht musst Du die von mir angegebene Variable vRange so lassen und noch eine zusätzliche Variable einführen für die For .. next-Schleife.
Das kann ich hier leider nicht testen.
Morgen probiere ich das mal.

Gruß
Günter


Antwort 4 von logic

OK, Günter, danke so weit !

Ich bin leider die Excel-VB-Hilfe nicht gewohnt. Gebe ich "xlDown" ein, erhalte ich exakt 0 Treffer. Und das ist schade. Bzw. bin ich von Lotus Notes nicht gewohnt.

Daher kann ich so leider nicht die Auswirkungen nachlesen.

Ich denke Dein Ansatz ist schonmal prima.
Bin gespannt auf Deinen Test.

Logic

Antwort 5 von Guenter

Hallo,

bei mir werden die doppelten Einträge in einer Spalte gelöscht.
Ich markiere Spalte A und lasse das Makro laufen. Hier ist mein code:


Option Explicit

Sub DoppEintraegeEntf()
    On Error GoTo ErrorHandler

    'MousePointer = fmMousePointerHourGlass 'Ändere Mauszeiger
    Application.ScreenUpdating = False 'Bildschirmanzeige nicht updaten

    '---> Eigentlicher Code
    Dim vRange As Variant
    Dim wRange
    Dim c As Variant
    Dim lCounter As Long
    lCounter = 0
    Set vRange = Selection.Cells
    'For c = vRange.Cells.Count To 1 Step -1
    Set wRange = Selection.Cells.End(xlDown)
    For c = wRange To 1 Step -1
        If Application.CountIf(vRange, vRange(c)) <> 1 Then
            vRange(c).Value = ""
            lCounter = lCounter + 1
            Else
        End If
    Next c
    Application.ScreenUpdating = True
    MsgBox lCounter & " Zelleinträge gelöscht.", 64
    '<---
ExitScript:
    'MousePointer = fmMousePointerDefault 'Mauszeiger wieder Standard
    Application.ScreenUpdating = True
    Exit Sub

ErrorHandler:
    MsgBox "Es ist ein Fehler aufgetreten." & Chr(10) & Chr(10) _
    & "Fehlermeldung: " & Error$ & Chr(10) _
    & "Fehlernummer: " & Err & Chr(10) _
    , 64, "Error"
    Resume ExitScript
End Sub


Wie bereits gesagt läuft die For... next-Schleife nur bis zum Ende der beschriebenen Zellen in der markierten Spalte.

Gruß
Günter

Antwort 6 von logic

Sorry, Günter, für die späte Rückmeldung.

Leider funktioniert Dein Script nicht ganz.

Folgender Test:
Ich schreibe in Spalte C in die Zeile 5 und in die Zeile 15 einen Buchstaben "test". Dann markiere ich die komplette Spalte C.
Anforderung ist, jetzt zu erkennen dass sowohl in der Zeile 5 als auch 15 (der Spalte C) das Wort "test" steht, und es soll aus einer der beiden Zellen gelöscht werden (Value = "").

Beim Test erhalte ich Fehler No. 13 (Typen unverträglich).

Logic

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: