Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
Suche (for each) beschleunigen
zurück: Ribbons - AddIns? weiter: PPT von Excel aus befüllen Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Feedback Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
taunterstaller
Im Profil kannst Du frei den Rang ändern


Verfasst am:
19. Apr 2014, 13:27
Rufname:

Suche (for each) beschleunigen - Suche (for each) beschleunigen

Nach oben
       Version: Office 2010

Liebe Foristen,

ich verwende eine for each Schleife, um aus einer langen Liste an Datensätzen bestimmte Datensätze herauszusuchen und an einer anderen Stelle aufzulisten.

Leider ist das ... gräßlich... langsam...

So sieht der Anfang der Schleife aus:
Code:
For Each ZelleDatenbankKategorien In Sheets("Datenbank").Range("h2:h10000")


Ihr seht, das Ding soll fast 10.000 Zeilen durchsuchen.
Wenn ich die Range verringere (zB auf 1.000 Zeilen) dann läufts auch deutlich schneller. Problem: Die Länge der Datensatz-Liste ist im Vorhinein nicht bekannt, bewegt sich aber auf alle Fälle zwischen 500 und 10.000 Zeilen.

Fällt euch aus dem Stand etwas ein, wie man diese Schleife eleganter gestalten könnte, dass sie schneller vorwärts kommt? zB indem sie die leeren Zeilen nicht auch noch durchsucht?

Mir fällt bei der Code-Ausführung auf:
Die Datensatzliste ist 700 Zeilen groß, es befinden sich 8 gesuchte Zeilen darin.
Die Suche findet die gesuchten 8 Zeilen sofort und listet sie auch sofort auf (also fast zeitgleich mit dem Mausklick) - aber danach scheint sie ewig durch die restlichen fast 9.000 leeren Zeilen zu eiern. Das dauert komischerweise viel viel länger...?

Vielen Dank schon im Voraus!
Phelan XLPH
Fortgeschritten


Verfasst am:
19. Apr 2014, 13:30
Rufname: Phelan


AW: Suche (for each) beschleunigen - AW: Suche (for each) beschleunigen

Nach oben
       Version: Office 2010

Hallo,

und wo ist der 'Auflisten'-Code?

_________________
Was vorstellbar ist, ist auch machbar. - Albert Einstein
Gast



Verfasst am:
19. Apr 2014, 13:42
Rufname:

AW: Suche (for each) beschleunigen - AW: Suche (for each) beschleunigen

Nach oben
       Version: Office 2010

Kann mich Phelan XLPH nur anschließen. Poste den vollständigen Code, dann kann dir auch geholfen werden.
Phelan XLPH
Fortgeschritten


Verfasst am:
19. Apr 2014, 13:45
Rufname: Phelan

AW: Suche (for each) beschleunigen - AW: Suche (for each) beschleunigen

Nach oben
       Version: Office 2010

Hallo,

benutze den Autofilter.

_________________
Was vorstellbar ist, ist auch machbar. - Albert Einstein
taunterstaller
Im Profil kannst Du frei den Rang ändern


Verfasst am:
19. Apr 2014, 14:14
Rufname:


AW: Suche (for each) beschleunigen - AW: Suche (for each) beschleunigen

Nach oben
       Version: Office 2010

Danke für eure Hilfsbereitschaft!

Hier ist der Code:

Code:
    For Each ZelleDatenbankKategorien In Sheets("Datenbank").Range("h2:h10000")
   
    Set ZeileZelleDatenbankKategorien = ZelleDatenbankKategorien

    'Abgleich, ob auch wirklich die richtige Person gemeint ist
    If ZelleDatenbankKategorien.Value = "Disziplinarisch" _
    And Sheets("Datenbank").Cells(ZeileZelleDatenbankKategorien.Row, 1).Value = Sheets("Einzelansicht").Range("b1").Value _
    And Sheets("Datenbank").Cells(ZeileZelleDatenbankKategorien.Row, 2).Value = Sheets("Einzelansicht").Range("d1").Value _
    And Sheets("Datenbank").Cells(ZeileZelleDatenbankKategorien.Row, 4).Value = Sheets("Einzelansicht").Range("f1").Value _
    And Sheets("Datenbank").Cells(ZeileZelleDatenbankKategorien.Row, 5).Value = Sheets("Einzelansicht").Range("h1").Value _
    And Sheets("Datenbank").Cells(ZeileZelleDatenbankKategorien.Row, 3).Value = Sheets("Einzelansicht").Range("j1").Value Then
       
    'Übertragen aller Werte
    Sheets("Einzelansicht").Cells(i, 1).Value = Sheets("Datenbank").Cells(ZeileZelleDatenbankKategorien.Row, SpalteDatenbankKategorie2).Value
    Sheets("Einzelansicht").Cells(i, 2).Value = Sheets("Datenbank").Cells(ZeileZelleDatenbankKategorien.Row, SpalteDatenbankDatum).Value
    Sheets("Einzelansicht").Cells(i, 3).Value = Sheets("Datenbank").Cells(ZeileZelleDatenbankKategorien.Row, SpalteDatenbankKategorie3).Value
   

    i = i + 1
   
    Else
    End If

    Next ZelleDatenbankKategorien
   


    Sheets("Einzelansicht").Range("EinzelansichtAlleDisziAuflistung").Sort key1:=Range("EinzelansichtAlleDisziAuflistungErstesFeld"), order1:=xlDescending, Header:=xlNo


Kann ich den Autofilter so integrieren dass er dasselbe erreicht?
Phelan XLPH
Fortgeschritten


Verfasst am:
19. Apr 2014, 15:17
Rufname: Phelan

AW: Suche (for each) beschleunigen - AW: Suche (for each) beschleunigen

Nach oben
       Version: Office 2010

Hallo,

das dürfte jetzt etwas flotter sein.

Code:
Sub Filtern_xlph()
    Dim FilterKriterien(1 To 6) As Variant
   
    Dim SpalteDatenbankKategorie2 As Integer
    Dim SpalteDatenbankDatum As Integer
    Dim SpalteDatenbankKategorie3  As Integer
   
    Dim rngKopie As Range
    Dim lngKopieZielZeile As Long
   
    Dim wksQuelle As Worksheet
    Dim wksZiel As Worksheet
   
   
    Set wksQuelle = ThisWorkbook.Worksheets("Datenbank")
    Set wksZiel = ThisWorkbook.Worksheets("Einzelansicht")
   
    ' ggf. Spalten anpassen
    SpalteDatenbankKategorie2 = 10
    SpalteDatenbankDatum = 12
    SpalteDatenbankKategorie3 = 14
   
    lngKopieZielZeile = 3
   
    Application.ScreenUpdating = False
   
    With wksZiel
        FilterKriterien(1) = .Range("B1").Value
        FilterKriterien(2) = .Range("D1").Value
        FilterKriterien(3) = .Range("J1").Value
        FilterKriterien(4) = .Range("F1").Value
        FilterKriterien(5) = .Range("H1").Value
        FilterKriterien(6) = "Disziplinarisch"
    End With
   
    With wksQuelle
        If .AutoFilterMode Then .AutoFilterMode = False
        .Range("A1").AutoFilter Field:=1, Criteria1:=FilterKriterien(1)
        .Range("A1").AutoFilter Field:=2, Criteria1:=FilterKriterien(2)
        .Range("A1").AutoFilter Field:=3, Criteria1:=FilterKriterien(3)
        .Range("A1").AutoFilter Field:=4, Criteria1:=FilterKriterien(4)
        .Range("A1").AutoFilter Field:=5, Criteria1:=FilterKriterien(5)
        .Range("A1").AutoFilter Field:=8, Criteria1:=FilterKriterien(6)
           
        Set rngKopie = Intersect(.Range("A1").CurrentRegion.EntireRow, _
                            Union(.Columns(SpalteDatenbankKategorie2), _
                                  .Columns(SpalteDatenbankDatum), _
                                  .Columns(SpalteDatenbankKategorie3)))
           
        If Not rngKopie Is Nothing Then
            With wksZiel
                .Range("A" & lngKopieZielZeile).Resize(.Rows.Count - lngKopieZielZeile - 1, 3).Clear
                rngKopie.Offset(1).Copy .Range("A" & lngKopieZielZeile)
            End With
            Set rngKopie = Nothing
        End If
                   
        ' Autofilter zurücksetzen
        .Range("A1").AutoFilter
           
    End With
   
    Application.ScreenUpdating = True
   
    Set wksQuelle = Nothing
    Set wksZiel = Nothing
   
End Sub

_________________
Was vorstellbar ist, ist auch machbar. - Albert Einstein
Storax
Trained for years. Now I'm ready to strike


Verfasst am:
19. Apr 2014, 16:10
Rufname:

AW: Suche (for each) beschleunigen - AW: Suche (for each) beschleunigen

Nach oben
       Version: Office 2010

Anstatt VBA code würde ich zwei andere Wege vorschlagen
1. Du machst das in einer Access Datenbank, dann erhältst Du dort über Abfragen, was Du benötigst
2. In Excel kann man den "Advanced Filter" benutzen. Der sollte mMn auch das liefern, was Du benötigst. Und der ist rasend schnell!

Und als dritte - vielleicht nicht so sinnvolle Wink - Alternative: Du bindest den entsprechenden Excelbereich in eine Access Datenbank ein und kannst dann darauf Access Abfragen loslassen

_________________
I will win but never fight
That's the Art of War!
Storax
Trained for years. Now I'm ready to strike


Verfasst am:
19. Apr 2014, 16:44
Rufname:

AW: Suche (for each) beschleunigen - AW: Suche (for each) beschleunigen

Nach oben
       Version: Office 2010

Die letzte Möglichkeit Smile kann man auch direkt in Excel mit Hilfe von ADODB umsetzen, z.B.

Code:
Sub GetData()

Dim DBFullName As String
Dim Cnct As String, strsQL As String

'  Verweis auf Microsoft ActiveX Data Objects Library nötig
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset


   DBFullName = ThisWorkbook.Path & "\" & ThisWorkbook.Name

   Set Cn = New ADODB.Connection
   Cnct = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & DBFullName & "';Extended Properties='Excel 12.0;HDR=Yes;IMEX=1';"
   Cn.Open ConnectionString:=Cnct

   Set Rs = New ADODB.Recordset
   ' MyDB ist ein benannter Bereich mit "Überschriften=Spalten"
   strsQL = "SELECT MyDB.Field1, MyDB.Field2, MyDB.Field3, MyDB.Field4 FROM MyDB;"

   Rs.Open strsQL, Cn, adOpenDynamic, adLockReadOnly

  ' Filtern geht z.B. wie folgt
   Rs.Filter = "Field3 ='<criteria>'"
   Range("H1").Offset(1, 0).CopyFromRecordset Rs
   Rs.Filter = ""
   Range("M1").Offset(1, 0).CopyFromRecordset Rs
   Rs.Close
   Set Rs = Nothing
   Cn.Close
   Set Cn = Nothing

End Sub

_________________
I will win but never fight
That's the Art of War!
taunterstaller
Im Profil kannst Du frei den Rang ändern


Verfasst am:
19. Apr 2014, 17:10
Rufname:

AW: Suche (for each) beschleunigen - AW: Suche (for each) beschleunigen

Nach oben
       Version: Office 2010

@ Phelan XLPH:

Whoa, das ist extrem viel schneller, vielen Dank!
Ich habe alle Werte so angepasst dass es in meiner Tabelle funktioniert, jetzt versuche ich gerade alle verwendeten Befehle zu verstehen Smile

Danke nochmals, damit arbeite ich weiter!

@ Storax:

Ebenfalls vielen Dank, ich hatte schon überlegt, Excel und Access zu verknüpfen, was grundsätzlich vermutlich auch viel Sinn machen würde, ich habe mich aber vorerst dagegen entschieden (unter anderem weil ich für mich vorerst kaum Chancen sehe, zwei Programme in der mir vorgegebenen Zeit so gut zu beherrschen, dass das was wird...). Ich gehe aber davon aus, dass ich später den Datenbank-Teil an Access auslagern werde.
taunterstaller
Im Profil kannst Du frei den Rang ändern


Verfasst am:
19. Apr 2014, 18:29
Rufname:

AW: Suche (for each) beschleunigen - AW: Suche (for each) beschleunigen

Nach oben
       Version: Office 2010

Ich glaube ich habe das meiste inzwischen verstanden...aber mit der Sektion hier habe ich noch zu knabbern:

Code:
        If Not rngKopie Is Nothing Then
            With wksZiel
                .Range("A" & lngKopieZielZeile).Resize(.Rows.Count - lngKopieZielZeile - 1, 3).Clear
                rngKopie.Offset(1).Copy .Range("A" & lngKopieZielZeile)
            End With
            Set rngKopie = Nothing
        End If


Ich verstehe den Resize-Befehl nicht ganz...also da werden die Zeilen in einem Bereich gezählt, dann wird lngKopieZielZeile abgezogen und dann nochmal eins abgezogen? Und dann wird gelöscht was in dem Bereich steht?

Das mit dem rngKopie.Offset(1).Copy verstehe ich auch noch nicht...

Bin für Tipps dankbar, ich vermute mal dass es für jemand, der sich auskennt, ganz offensichtlich ist, aber ich sehe wohl grade den Wald nicht...
Phelan XLPH
Fortgeschritten


Verfasst am:
20. Apr 2014, 13:17
Rufname: Phelan

AW: Suche (for each) beschleunigen - AW: Suche (for each) beschleunigen

Nach oben
       Version: Office 2010

Code:
        ' Prüfen, ob 'rngKopie' einem Objekt (hier Zellbereich) zugewiesen wurde
        If Not rngKopie Is Nothing Then
            ' ...bezogen auf das ZielBlatt
            With wksZiel
                ' Ziel-Zellbereich säubern ab der StarZelle A(lngKopieZielZeile)
                ' Startzelle um (.Rows.Count - lngKopieZielZeile - 1) Zeilen und um 3 Spalten erweitert.
                ' Also: A[lngKopieZielZeile]:C[LetzteZeile der Tabelle]
                .Range("A" & lngKopieZielZeile).Resize(.Rows.Count - lngKopieZielZeile - 1, 3).Clear
                ' Ermittelter zu kopierender Zellbereich umd 1 Zeile nach unten verschieben und kopieren.
                ' Zweck: Überschrift nicht mitkopieren
                rngKopie.Offset(1).Copy .Range("A" & lngKopieZielZeile)
            End With
            ' Verweis auf 'rngKopie' löschen.
            Set rngKopie = Nothing
        End If

_________________
Was vorstellbar ist, ist auch machbar. - Albert Einstein
taunterstaller
Im Profil kannst Du frei den Rang ändern


Verfasst am:
20. Apr 2014, 14:16
Rufname:


AW: Suche (for each) beschleunigen - AW: Suche (for each) beschleunigen

Nach oben
       Version: Office 2010

Vielen vielen Dank Smile
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Excel Formeln: SVerweis, suche fortführen. Zeitspannen selbst ausfüllen. 2 Basti1282 975 24. Mai 2006, 14:12
Basti1282 SVerweis, suche fortführen. Zeitspannen selbst ausfüllen.
Keine neuen Beiträge Excel Formeln: einfaches for+if als formel? 7 dme 697 16. Mai 2006, 09:04
dme einfaches for+if als formel?
Keine neuen Beiträge Excel Formeln: Suche geeignete Funktion 7 Lustig 3218 21. Apr 2006, 07:11
Lustig Suche geeignete Funktion
Keine neuen Beiträge Excel Formeln: Suche und Wiedergabe eines Datums 2 Gregor75 591 20. März 2006, 21:13
Gregor75 Suche und Wiedergabe eines Datums
Keine neuen Beiträge Excel Formeln: Suche WENN Formel 4 Hooper 499 05. März 2006, 13:41
Hooper Suche WENN Formel
Keine neuen Beiträge Excel Formeln: Suche mit mehreren Suchkriterien 6 surfer6 973 23. Jan 2006, 14:03
surfer6 Suche mit mehreren Suchkriterien
Keine neuen Beiträge Excel Formeln: suche einfache wenn formel 2 Rosi 673 03. Jul 2005, 18:27
Rosi suche einfache wenn formel
Keine neuen Beiträge Excel Formeln: Suche Formel für Einzel,- Gesammt,- Durchschnitts- Preis 5 alter Anfänger 803 03. Mai 2005, 01:21
fl618 Suche Formel für Einzel,- Gesammt,- Durchschnitts- Preis
Keine neuen Beiträge Excel Formeln: Formel Suche für Excel 3 Tinaworldvision 607 27. Jan 2005, 18:52
Tinaworldvision Formel Suche für Excel
Keine neuen Beiträge Excel Formeln: Suche Formel, welche Spalte nur bis zum akt. Datum berechnet 7 Sveny 1609 04. Jan 2005, 21:45
Sveny Suche Formel, welche Spalte nur bis zum akt. Datum berechnet
Keine neuen Beiträge Excel Formeln: suche ähnliche Funktion wie ZÄHLENWENN 2 MrMr 1300 19. Nov 2004, 12:40
MrMr suche ähnliche Funktion wie ZÄHLENWENN
Keine neuen Beiträge Excel Formeln: Suche Formel für Fussballtipp 2 Kiko 2800 22. Aug 2004, 13:03
Big Earn Suche Formel für Fussballtipp
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: Word VBA