Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

suchen, Treffer-Zeilen löschen | Herbers Excel-Forum


Betrifft: suchen, Treffer-Zeilen löschen von: David
Geschrieben am: 16.11.2009 16:54:13

Hallo zusammen,

ich habe eine Export-Datei, in der bei 10.000 Gesamtzeilen etwa 2/3 nur aus kaskadierten Ergebniszeilen besteht. Eine Gliederung oder ähnliches ist nicht vorhanden, die Zeilen sind nur am Text "Ergebnis" zu identifizieren.
Da ich diese in der weiteren Verarbeitung nicht brauche, entferne ich sie per folgendem Code:

Sub mat_abw()

Dim Treffer

Do
Set Treffer = Range(ActiveSheet.UsedRange.Address).Find("Ergebnis")
    If Not Treffer Is Nothing Then
            Zeile = Treffer.Row
            Rows(Zeile).EntireRow.Delete
    End If
Loop Until Treffer Is Nothing

End Sub
Dies dauert auf meinem PC trotz diverser Beschleunigungsfunktionen (die ich hier nicht mit aufgeführt habe) ca. 1 Minute.
Ich frage mich nun, ob es eine schnellere Variante gibt und diese mir jemand aufzeigen kann.

Daneben noch eine zweite Frage:
Wenn ich in einer Zelle eine als Text formatierte Zahl habe, mit der entsprechenden Excel-Markierung, wie kann ich diesen "Fehlerwert" bzw. diese Eigenschaft in VBA auslesen? Ich habe in wechselnden Spalten solche Text-Zahlen und möchte (wieder aus Geschwindigkeitsgründen) nicht die ganze Tabelle abgrasen, sondern nur in der ersten Zeile danach suchen und nur bei einem Treffer dann die entsprechende Spalte "behandeln".

Danke vorab für jede Hilfe und schönen Abend (ich mach jetzt Feierabend)

Gruß
David

  

Betrifft: Nachfrage? von: Tino
Geschrieben am: 16.11.2009 17:09:14

Hallo,
steht dieser Suchwert in einer bestimmten Spalte?

Gruß Tino


  

Betrifft: bist Du Kaffee trinken? zwei Varianten... von: Tino
Geschrieben am: 16.11.2009 18:03:50

Hallo,
hier zwei Varianten.

1. Für eine Spalte, im Beispiel Spalte B
für eine andere Spalte die Zeile mit der Formel anpassen.
.Formula = "=IF(RC2=""" & strSuchwert & """,True,ROW())" 'entsprechende Formel


2. Für ganze Tabelle

In beiden Fällen muss eine freie Spalte zur Verfügung stehen. (1. neben UsedRange)

In beiden habe ich eine Zeitmessung eingebaut zum testen.

kommt als Code in Modul1

Option Explicit 
 
Sub Loeschen_Mit_Formel() 
Dim oSH As Worksheet, iCalc As Integer 
Dim sTimer As Single 
Dim strSuchwert As String 
 
sTimer = Timer 'zum Zeitmessen 
 
strSuchwert = "Ergebnis" 
 
Set oSH = Sheets("Tabelle1") 'Tabelle anpassen 
 
With Application 
 iCalc = .Calculation 
 .Calculation = xlCalculationManual 
 .ScreenUpdating = False 
  
     With oSH.UsedRange 
        With .Columns(.Columns.Count).Offset(0, 1) 
             
            .Formula = "=IF(RC2=""" & strSuchwert & """,True,ROW())" 'entsprechende Formel 
             
            oSH.UsedRange.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo 
             
            On Error Resume Next 
            .SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete 
            On Error GoTo 0 
             
            .EntireColumn.Delete 
        End With 
     End With 
  
 .ScreenUpdating = True 
 .Calculation = iCalc 
End With 
 
MsgBox "fertig nach: " & Timer - sTimer & " Sekunden" 
End Sub 
kommt als Code in Modul2
Option Explicit 
 
Sub Makro1() 
Dim meAr(), tmpAr() 
Dim A As Long, AA As Long 
Dim oSH As Worksheet 
Dim strSuchwert As String 
Dim sTimer As Single 
Dim iCalc As Integer 
 
sTimer = Timer 'zum Zeitmessen 
strSuchwert = "Ergebnis" 
 
Set oSH = Sheets("Tabelle1") 
 
If Application.WorksheetFunction.CountIf(oSH.Cells, strSuchwert) > 0 Then 
   With Application 
        iCalc = .Calculation 
        .ScreenUpdating = False 
        .Calculation = xlCalculationManual 
               With oSH.UsedRange 
                     
                    meAr = .Value2 
                    Redim Preserve tmpAr(1 To Ubound(meAr)) 
                     
                    For A = 1 To Ubound(meAr) 
                        For AA = 1 To Ubound(meAr, 2) 
                            If CStr(meAr(A, AA)) = strSuchwert Then 
                                tmpAr(A) = "=TRUE" 
                            ElseIf tmpAr(A) <> "=TRUE" Then 
                                tmpAr(A) = "=ROW()" 
                            End If 
                        Next AA 
                    Next A 
                     
                    With .Columns(.Columns.Count).Offset(0, 1) 
                         
                        .Cells(1, 1).Resize(A).FormulaR1C1 = Application.Transpose(tmpAr) 
                        oSH.UsedRange.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo 
                        On Error Resume Next 
                        .SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete 
                        On Error GoTo 0 
                        .EntireColumn.Delete 
                        
                    End With 
                 
                End With 'oSH.UsedRange 
         .ScreenUpdating = True 
         .Calculation = iCalc 
    End With 'Application 
End If 
 
MsgBox "fertig nach: " & Timer - sTimer & " Sekunden" 
End Sub 
Gruß Tino


  

Betrifft: AW: ... Feierabend! von: David
Geschrieben am: 17.11.2009 07:51:04

Hallo Tino,

hatte doch geschrieben, dass ich nach dem Abschicken der Frage in den Feierabend gehe. ;-)
Somit konnte ich deine Antwort erst heute morgen lesen.

Der Suchwert kommt in mehreren Spalten vor, so dass ich dies nicht auf eine Spalte reduzieren kann. Ansonsten hätte ich wahrscheinlich auch schon eine andere Variante gewählt.
Ich werd mir deine zweite Variante mal zu Gemüte führen und versuchen durchzusteigen.

Danke erst mal soweit.

Gruß
David


  

Betrifft: And The Winner Is ... von: David
Geschrieben am: 17.11.2009 09:05:52

Hallo Tino,

ich weiß nicht, wie das funktioniert, aber dein Code ist im Gegensatz zu meinen ca. 200s innerhalb einer (!!!!!) Sekunde fertig.
Erich muss sich leider mit dem dritten Platz (763s) begnügen. ;-)
(ich vermute, da der "Union"-Bereich mit jedem Durchlauf immer größer wird, bremst das den Code mit der Zeit immer mehr. Die ersten paar Tausend Zeilen gehen noch recht zügig, aber ab ca. 4-5 Tausend wirds immer "zäher", soviel haben ein paar kleine Tests ergeben)

@Tino:
Ich habe allerdings das Problem, dass ich deinen Code nicht ganz verstehe, somit momentan leider nicht als Wissens-Gewinn für mich verbuchen kann.
Vielleicht kannst du noch ein paar Kommentare dazu geben? Folgende Zeilen interessieren mich besonders (darin die fett gekennzeichneten Ausdrücke):

Redim Preserve tmpAr(1 To Ubound(meAr))
For A = 1 To Ubound(meAr)
.Cells(1, 1).Resize(A).FormulaR1C1 = Application.Transpose(tmpAr)

Danke schon mal.
Damit vermeide ich Irritationen bei den zukünftigen Anwender, die durch die lange Laufzeit wahrscheinlich entstanden wären.

Gruß
David


  

Betrifft: Code mit Kommentar von: Tino
Geschrieben am: 17.11.2009 14:50:22

Hallo,
sorry, die letzte Zeile habe ich nicht mehr richtig gelesen.
Habe den Code mit Kommentaren versehen.
Die Daten werden nach der Hilfsspalte sortiert,
so dass alle Zeilen die zu löschen sind zusammenhängen. (geht schneller)
Habe noch eine kleine Umstellung gemacht mit Exit For,
sollte noch die eine oder andere Millisekunde bringen.

Sub Makro1()
Dim meAr(), tmpAr()
Dim A As Long, AA As Long
Dim oSH As Worksheet
Dim strSuchwert As String
Dim sTimer As Single
Dim iCalc As Integer
 
sTimer = Timer 'zum Zeitmessen 
'Dein Suchwert 
strSuchwert = "Ergebnis"
 
Set oSH = Sheets("Tabelle1")
'gibt es im Usedrange den Suchwert? 
If Application.WorksheetFunction.CountIf(oSH.Cells, strSuchwert) > 0 Then
   With Application
        iCalc = .Calculation
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
               
               With oSH.UsedRange
                    
                    'Array aus Datenbereich erstellen 
                    meAr = .Value2
                    'größe des Hilfs Array festlegen 
                    Redim Preserve tmpAr(1 To Ubound(meAr))
                    
                    'Schleife über alle Daten im Aray 
                    For A = 1 To Ubound(meAr)
                        'erst Formel für Zeile einfügen 
                        tmpAr(A) = "=ROW()"
                        For AA = 1 To Ubound(meAr, 2)
                            If CStr(meAr(A, AA)) = strSuchwert Then
                                tmpAr(A) = "=TRUE" 'Formel für Trefferzeile 
                                Exit For 'gefunden kann Schleife verlassen werden 
                            End If
                        Next AA
                    Next A
                    'Spalte neben UsedRange 
                    With .Columns(.Columns.Count).Offset(0, 1)
                        'Hilfsspalte mit der Formel aus Hilfsarray füllen, Transpose = Array drehen 
                        .Cells(1, 1).Resize(A).FormulaR1C1 = Application.Transpose(tmpAr)
                        'nach Hilfsspalte Sortieren 
                        oSH.UsedRange.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
                        On Error Resume Next
                        'alle Zeilen mit dem Ergebnis Wahr löschen 
                        .SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
                        On Error GoTo 0
                        'Hilfsspalte löschen 
                        .EntireColumn.Delete
                    End With
                 
                End With 'oSH.UsedRange 
         .ScreenUpdating = True
         .Calculation = iCalc
    End With 'Application 
End If
 
MsgBox "fertig nach: " & Timer - sTimer & " Sekunden"
End Sub
Gruß Tino


  

Betrifft: AW: Code mit Kommentar von: David
Geschrieben am: 17.11.2009 15:09:43

Danke, das hilft schon mal ein Stück weiter.
Ich hatte zunächst noch die Befürchtung, dass durch die Sortierung die restlichen Daten auch mit umsortiert werden. Dies wäre auf jeden Fall nicht akzeptabel gewesen, da zu dem Zeitpunkt etliche Zellen noch leer wären, die werden erst im Lauf des weiteren Codes per Kopie von den darüber liegenden Zeilen gefüllt. Aber nach einem Test habe ich gesehen, dass die Reihenfolge der restlichen Zeilen unverändert war.

Auf die noch möglichen Verbesserungen kommt es bei einer Laufzeit von unter einer Sekunde auf jeden Fall nicht an.

Ich merke immer wieder, das man mit Arrays spannende Sachen machen kann. Allerdings ist das teilweise auch schwer zu verstehen und vor allem schwer, erst mal auf die IDEE zu kommen.

Hut ab!

Nochmals Danke.

Gruß
David


  

Betrifft: Sortierung kommt daher nicht durcheinander... von: Tino
Geschrieben am: 17.11.2009 15:20:15

Hallo,
, weil in der Zelle wenn nicht Ergebnis gefunden wurde die Zeilennummer steht.

Gruß Tino



  

Betrifft: noch Erklärung von: Tino
Geschrieben am: 17.11.2009 15:16:43

Hallo,
Redim Preserve tmpAr(1 To Ubound(meAr))
Legt die Größe des Array fest, Ubound stellt dabei die Anzahl der Zeilen fest.

For A = 1 To Ubound(meAr)
Schleife über alle Zeilen im Array.

.Cells(1, 1).Resize(A).FormulaR1C1 = Application.Transpose(tmpAr)
Array muss gedreht werden (Transpose),
sonst passt dass Array von der Struktur nicht in die Spalte.

Anders kann ich es nicht erklären und hoffe es ist so richtig gerade im Bezug auf die Zeilen.

Gruß Tino


  

Betrifft: AW: noch Erklärung von: David
Geschrieben am: 17.11.2009 15:21:40

Passt schon, danke.

Gruß
David


  

Betrifft: Suchen + löschen, Zahl als Text von: Erich G.
Geschrieben am: 16.11.2009 19:19:24

Hi David,
noch eine Variante zum Find-Problem und ein Vorschlag,
wie du die "Text-Zahlen" identifizieren könntest:

Option Explicit      ' IMMER ZU EMPFEHLEN !

Sub mat_abw2()
   Dim rngF As Range, lngFirst As Long, rngDel As Range

   With ActiveSheet.UsedRange
      Set rngF = .Find(What:="Ergebnis", After:=.Cells(.Rows.Count, .Columns.Count), _
         LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
         SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
      If Not rngF Is Nothing Then
         lngFirst = rngF.Row              ' Zeile des 1. Treffers
         Do
            If rngDel Is Nothing Then
               Set rngDel = rngF
            Else
               Set rngDel = Union(rngDel, rngF)
            End If
            Set rngF = .FindNext(Cells(rngF.Row, .Column + .Columns.Count - 1))
         Loop While rngF.Row > lngFirst
         rngDel.EntireRow.Delete          ' hier wird gelöscht
      End If
   End With
End Sub

Sub TextIstZahl()
   Dim lngZ As Long, lngS As Long

   lngZ = 2             ' untersuchte Zeile

   For lngS = 1 To 20   ' Schleife über Spalten
      If IsNumeric(Cells(lngZ, lngS)) And Application.IsText(Cells(lngZ, lngS)) Then
         MsgBox "Spalte " & lngC & " bearbeiten"
      End If
   Next lngS
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: AW: Suchen + löschen, Zahl als Text von: David
Geschrieben am: 17.11.2009 09:37:27

Hallo Erich,

zu meinem zweiten Problem:

Dein Code funzt nach einer kleinen Anpassung.

Die Zeile

MsgBox "Spalte " & lngC & " bearbeiten"

muss heißen

MsgBox "Spalte " & lngS & " bearbeiten"

Hätte dir eigentlich auffallen müssen, wenn du "Option Explicit" (so wie ich) immer benutzt. ;-)

Ich hatte dies in meinem ersten Posting nur nicht mit drin, da der Code dort etwas verkürzt war.

Allerdings hätte ich erwartet, dass es für diesen "Fehler", den Excel da immer anmeckert, einen internen Fehlerwert gibt, den man direkt auslesen kann. Aber da es auch so klappt, ist's ok und da es nur ca. 25 Spalten sind, auch von der Performance her irrelevant.

Danke und Gruß
David


  

Betrifft: Danke für Rückmeldung, ... von: Erich G.
Geschrieben am: 17.11.2009 16:34:07

Hi David,
... und noch ein paar kleine Bemerkungen:

"Option Explicit" benutze ich tatsächlich immer. Trotzdem ist mir mein Fehler nicht aufgefallen -
nach dem (unvollständigen) Ersetzen von lngC durch lngS hab ich den Code weder kompiliert noch getestet,
sondern ihn dummerweise so ins Forum kopiert... Das kann schon mal passieren. ;-)

Dass ich "IMMER ZU EMPF..." hingeschrieben habe, hatte einen Grund: In deiner Routine mat_abw()
war wohl die Variable "Treffer" (aber als Variant), die Variabel "Zeile" aber gar nicht deklariert.

Dass mein Such- und Löschcode viel langsamer insbesondere als Tinos Code (:-)) war
und auf dem ehrenvollen dritten Platz gelandet ist, war eigentlich auch absehbar...

Eine kleine Vereinfachung noch zu Tinos Code. In der Zeile
Redim Preserve tmpAr(1 To Ubound(meAr))
ist das Preserve überflüssig - es sollen ja keine Daten beibehalten werden, weil noch keine drin sind.
Auf das Zeitverhalten wird sich diese einmalige Aktion nicht auswirken.

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


Beiträge aus den Excel-Beispielen zum Thema "suchen, Treffer-Zeilen löschen"