Schneller SVERWEIS bzw. INDEX / VERGLEICH

[GMG-CC]

OK, ich habe die Datei einmal auf meinen Server hoch geladen. Das nächste Vierteljahr lasse ich sie dort stehen ...

Hier der Link

Natürlich ist es auch möglich, von einer eigenständigen *.xlsx auf die Basis-Daten zuzugreifen, falls sich diese ständig ändern; nur der Filename solle dann gleich sein ...

[snb]

In der Datei der @CMG auf seinem Server gesetzt hat (vielen Dank !!).
dauerte dieses Macro 32 sekunden.

Code:

Sub M_snb()
  t1 = Timer
  Dim sp(10)
    
  With CreateObject("scripting.dictionary")
    For j = 1 To 3
      sn = Sheets(Choose(j, "Umsatz", "Artikel", "Besuche")).Cells(1).CurrentRegion
      For jj = 2 To UBound(sn)
        st = sp
        If .exists(sn(jj, 1)) Then st = .Item(sn(jj, 1))
        For jjj = 1 To 5
          st(Choose(jjj, 0, 1, 1 + j, 4 + j, 7 + j)) = sn(jj, jjj)
        Next
        .Item(sn(jj, 1)) = st
      Next
    Next
        
    ReDim sq(.Count, 10)
    j = 0
    For Each it In .keys
      st = .Item(it)
      For jj = 0 To 10
        sq(j, jj) = st(jj)
      Next
      j = j + 1
    Next
    
     Sheet9.Cells(1).Resize(.Count, 10) = sq
  End With

  MsgBox Timer - t1
End Sub

[Ego]

Hallo,

Ich bewundere snb's kompakte Programm und würde es, wenn Power Querry nicht in Frage kommt auch einsetzen. Insbesondere, da es keine sortierten Listen vorraussetzt.
Auf meinem Rechner benötigt das Programm für die ca 250.000 Einträge  < 23 Sekunden.

Wenn es aber wirklich auf die Geschwindigkeit ankommt und sichergestellt ist, dass die Listen sortiert sind, kann man auf den kleinen Overhead fürs dictionary verzichten und die Auswertung über einfache Schleifen realisieren. Dann benötigt das Programm auf meinem Rechner für die ca. 250.000 Einträge < 8 Sekunden.

Code:

Sub tuwat()
Anf = Timer
Dim ZeKu As Long
Dim ZeUm As Long
Dim ZeAr As Long
Dim ZeBe As Long
Dim MaxUm As Long
Dim MaxAr As Long
Dim MaxBe As Long
Dim Res()
Dim Ku As Variant
Dim Um As Variant
Dim Ar As Variant
Dim Be As Variant
Ku = Sheets("Kunden").Cells(1).CurrentRegion
Um = Sheets("Umsatz").Cells(1).CurrentRegion
Ar = Sheets("Artikel").Cells(1).CurrentRegion
Be = Sheets("Besuche").Cells(1).CurrentRegion
ReDim Res(1 To UBound(Ku, 1), 1 To 11)
MaxUm = UBound(Um, 1)
MaxAr = UBound(Ar, 1)
MaxBe = UBound(Be, 1)
ZeUm = 2
ZeAr = 2
ZeBe = 2
For ZeKu = 2 To UBound(Ku, 1)
    While Um(ZeUm, 1) < Ku(ZeKu, 1)
        ZeUm = ZeUm + 1
    Wend
    While Ar(ZeAr, 1) < Ku(ZeKu, 1)
        ZeAr = ZeAr + 1
    Wend
    While Be(ZeBe, 1) < Ku(ZeKu, 1)
        ZeBe = ZeBe + 1
    Wend
    
    Res(ZeKu, 1) = Ku(ZeKu, 1)
    Res(ZeKu, 2) = Ku(ZeKu, 2)
    If Um(ZeUm, 1) = Ku(ZeKu, 1) Then
        Res(ZeKu, 3) = Um(ZeUm, 3)
        Res(ZeKu, 6) = Um(ZeUm, 4)
        Res(ZeKu, 9) = Um(ZeUm, 5)
        If ZeUm = MaxUm Then
            Um(ZeUm, 1) = 9 ^ 9
        Else
            ZeUm = ZeUm + 1
        End If
    End If
    If Ar(ZeAr, 1) = Ku(ZeKu, 1) Then
        Res(ZeKu, 4) = Ar(ZeAr, 3)
        Res(ZeKu, 7) = Ar(ZeAr, 4)
        Res(ZeKu, 10) = Ar(ZeAr, 5)
        If ZeAr = MaxAr Then
            Ar(ZeAr, 1) = 9 ^ 9
        Else
            ZeAr = ZeAr + 1
        End If
    End If
    If Be(ZeBe, 1) = Ku(ZeKu, 1) Then
        Res(ZeKu, 5) = Be(ZeBe, 3)
        Res(ZeKu, 8) = Be(ZeBe, 4)
        Res(ZeKu, 11) = Be(ZeBe, 5)
        If ZeBe = MaxBe Then
            Be(ZeBe, 1) = 9 ^ 9
        Else
            ZeBe = ZeBe + 1
        End If
    End If
    
Next ZeKu
Sheets("Sheet9").Cells(1, 13).Resize(UBound(Res, 1), UBound(Res, 2)) = Res
MsgBox Timer - Anf
End Sub

ps. Fenneks Version benötigt auf meinem Rechner > 700 Sekunden.

[snb]

Es kann schneller/einfacher - meine Rechner 1,8 Sek.:

Code:

Sub M_snb()
  t1 = Timer

  c00 = "SELECT `Umsatz$`.Kundennummer, `Umsatz$`.Kundenname, `Umsatz$`.`Umsatz 2014`, `Artikel$`.`Artikel 2014`, `Besuche$`.`Besuche 2014`, `Umsatz$`.`Umsatz 2015`, `Artikel$`.`Artikel 2015`, `Besuche$`.`Besuche 2015`, `Umsatz$`.`Umsatz 2016`, `Artikel$`.`Artikel 2016`, `Besuche$`.`Besuche 2016`FROM `G:\OF\__Beispieldatei.xlsb`.`Artikel$` `Artikel$`, `G:\OF\__Beispieldatei.xlsb`.`Besuche$` `Besuche$`, `G:\OF\__Beispieldatei.xlsb`.`Umsatz$` `Umsatz$`WHERE `Artikel$`.Kundennummer = `Besuche$`.Kundennummer AND `Artikel$`.Kundennummer = `Umsatz$`.Kundennummer"
  
  With CreateObject("ADODB.Recordset")
    .Open c00, "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0"""
    Sheet9.Cells(1).CopyFromRecordset .DataSource
  End With

  MsgBox Timer - t1
End Sub

23 Sek. :

Code:

Sub M_snb()
  t1 = Timer
 
  Dim sp(3 * 10 ^ 5, 10)
    
  With CreateObject("scripting.dictionary")
    For j = 1 To 3
      sn = Sheets(Choose(j, "Umsatz", "Artikel", "Besuche")).Cells(1).CurrentRegion
      For jj = 2 To UBound(sn)
        If Not .exists(sn(jj, 1)) Then .Item(sn(jj, 1)) = .Count
        
        y = .Item(sn(jj, 1))
        For jjj = 1 To 5
          sp(y, Choose(jjj, 0, 1, 1 + j, 4 + j, 7 + j)) = sn(jj, jjj)
        Next
      Next
    Next
    
    Sheet9.Cells(1).Resize(.Count, 10) = sp
  End With

  MsgBox Timer - t1
End Sub

Mann kan auch händsich ein Querytable machen.

[friedensbringer]

Hallo snb, hallo Ego,

wow das schaut von den Zeiten her ja absolut vielversprechend aus. Vielen Dank für die rege Anteilnahme an meinem "Problem".
Muss ich um das zu testen nur noch den entsprechenden Code von snb in die Arbeitsmappe kopieren oder sind noch weitere Anpassungen notwendig?

Was macht der erste Teil des Codes und was der zweite Teil von snb?

Wodurch ergibt sich hier dieser extreme Performancevorteil? Wird das mittels Arrays erreicht?

Ich habe zwar grundlegende VBA Kenntnisse, aber durchschaue leider die hier geposteten Codes noch nicht so ganz
was mir schon ein sehr großes Anliegen wäre, damit ich so etwas dann eventuell irgendwann auch selber auf die Reihe
bekomme bzw. für andere Dateien entsprechend umbauen kann.

Ich weiß dass das eine große Bitte ist, aber wäre es vielleicht möglich den Code noch etwas zu kommentieren damit ich grob verstehe was an welche Stelle gemacht wird?
Bzw. die Datei mit dem entsprechenden Code hochzuladen, kann ja von den Zeilen her eine "abgespeckte" Version sein.

Und um nochmals auf meinen ganz ursprünglichen Post zurückzukommen, kann mir hier vielleicht auch einer der "Formel-Gurus" sagen wie ihr das ohne VBA usw. lösen würdet?
Also beispielsweise über INDEX / VERGLEICH:

INDEX-MATCH in Two Formulas, Sorted Data

Finally, this trial uses separate formulas for INDEX and MATCH:

B3:    =INDEX(Data,$G3,B$1)
G3:    =MATCH($A3,Code,1)

Here, we can modify cell G3 to give us an exact match:

G3:    =IF(INDEX(Code,MATCH($A3,Code,1))=$A3, MATCH($A3,Code,1), NA())

In other words, using the two-formula INDEX-MATCH approach against sorted data can be significantly faster than using either VLOOKUP or the one-formula INDEX-MATCH technique, and is best practice. 

Net Calculation Time for Approximate Match: 0.391
Net Calculation Time for Exact-Match Version: 0.438

Ich hoffe ihr könnt mir da weiterhelfen das so wie dort in rot angegeben hinzubekommen.

Vielen, vielen Dank und lg

Olli

[friedensbringer]

Hallo,

Ich bewundere snb's kompakte Programm und würde es, wenn Power Querry nicht in Frage kommt auch einsetzen. Insbesondere, da es keine sortierten Listen vorraussetzt.
Auf meinem Rechner benötigt das Programm für die ca 250.000 Einträge  < 23 Sekunden.

Wenn es aber wirklich auf die Geschwindigkeit ankommt und sichergestellt ist, dass die Listen sortiert sind, kann man auf den kleinen Overhead fürs dictionary verzichten und die Auswertung über einfache Schleifen realisieren. Dann benötigt das Programm auf meinem Rechner für die ca. 250.000 Einträge < 8 Sekunden.

Code:

Sub tuwat()
Anf = Timer
Dim ZeKu As Long
Dim ZeUm As Long
Dim ZeAr As Long
Dim ZeBe As Long
Dim MaxUm As Long
Dim MaxAr As Long
Dim MaxBe As Long
Dim Res()
Dim Ku As Variant
Dim Um As Variant
Dim Ar As Variant
Dim Be As Variant
Ku = Sheets("Kunden").Cells(1).CurrentRegion
Um = Sheets("Umsatz").Cells(1).CurrentRegion
Ar = Sheets("Artikel").Cells(1).CurrentRegion
Be = Sheets("Besuche").Cells(1).CurrentRegion
ReDim Res(1 To UBound(Ku, 1), 1 To 11)
MaxUm = UBound(Um, 1)
MaxAr = UBound(Ar, 1)
MaxBe = UBound(Be, 1)
ZeUm = 2
ZeAr = 2
ZeBe = 2
For ZeKu = 2 To UBound(Ku, 1)
    While Um(ZeUm, 1) < Ku(ZeKu, 1)
        ZeUm = ZeUm + 1
    Wend
    While Ar(ZeAr, 1) < Ku(ZeKu, 1)
        ZeAr = ZeAr + 1
    Wend
    While Be(ZeBe, 1) < Ku(ZeKu, 1)
        ZeBe = ZeBe + 1
    Wend
    
    Res(ZeKu, 1) = Ku(ZeKu, 1)
    Res(ZeKu, 2) = Ku(ZeKu, 2)
    If Um(ZeUm, 1) = Ku(ZeKu, 1) Then
        Res(ZeKu, 3) = Um(ZeUm, 3)
        Res(ZeKu, 6) = Um(ZeUm, 4)
        Res(ZeKu, 9) = Um(ZeUm, 5)
        If ZeUm = MaxUm Then
            Um(ZeUm, 1) = 9 ^ 9
        Else
            ZeUm = ZeUm + 1
        End If
    End If
    If Ar(ZeAr, 1) = Ku(ZeKu, 1) Then
        Res(ZeKu, 4) = Ar(ZeAr, 3)
        Res(ZeKu, 7) = Ar(ZeAr, 4)
        Res(ZeKu, 10) = Ar(ZeAr, 5)
        If ZeAr = MaxAr Then
            Ar(ZeAr, 1) = 9 ^ 9
        Else
            ZeAr = ZeAr + 1
        End If
    End If
    If Be(ZeBe, 1) = Ku(ZeKu, 1) Then
        Res(ZeKu, 5) = Be(ZeBe, 3)
        Res(ZeKu, 8) = Be(ZeBe, 4)
        Res(ZeKu, 11) = Be(ZeBe, 5)
        If ZeBe = MaxBe Then
            Be(ZeBe, 1) = 9 ^ 9
        Else
            ZeBe = ZeBe + 1
        End If
    End If
    
Next ZeKu
Sheets("Sheet9").Cells(1, 13).Resize(UBound(Res, 1), UBound(Res, 2)) = Res
MsgBox Timer - Anf
End Sub

ps. Fenneks Version benötigt auf meinem Rechner > 700 Sekunden.

Hallo Ego,

danke - funktioniert super bei und auch unter 8 Sekunden. Bei der Version von Fennek hatte ich leider auch das gleiche Problem mit der langen Zeit, zumindest dann wenn es wirklich 200.000 Zeilen waren.
Kannst du vielleicht auch den Code noch ein wenig für mich kommentieren damit ich mehr verstehe was wo gemacht wird?

Sofern ich das korrekt verstehe werden zu Beginn die jeweiligen Bereiche aus den Blättern in eine Variable geschrieben.
Danach wird ein Array gemacht? Oder was macht das ReDim und UBound genau?

Dann gibt es einige Schleifen, aber was ist da ZeUm, ZeAr, ZeBe genau, ich nehmen an das steht für die jeweiligen Bereiche, aber warum ist das zu Beginn der Schleife immer 2?
Was macht Wend, was macht Res?

Vielen Dank für eure Hilfe, ich bin da wirklich sehr bestrebt das zu verinnerlichen und nicht nur einfach 1:1 in meine Mappe zu kopieren.

Vielen Dank und lg

Olli

[friedensbringer]

Es kann schneller/einfacher - meine Rechner 1,8 Sek.:

Code:

Sub M_snb()
 t1 = Timer

 c00 = "SELECT `Umsatz$`.Kundennummer, `Umsatz$`.Kundenname, `Umsatz$`.`Umsatz 2014`, `Artikel$`.`Artikel 2014`, `Besuche$`.`Besuche 2014`, `Umsatz$`.`Umsatz 2015`, `Artikel$`.`Artikel 2015`, `Besuche$`.`Besuche 2015`, `Umsatz$`.`Umsatz 2016`, `Artikel$`.`Artikel 2016`, `Besuche$`.`Besuche 2016`FROM `G:\OF\__Beispieldatei.xlsb`.`Artikel$` `Artikel$`, `G:\OF\__Beispieldatei.xlsb`.`Besuche$` `Besuche$`, `G:\OF\__Beispieldatei.xlsb`.`Umsatz$` `Umsatz$`WHERE `Artikel$`.Kundennummer = `Besuche$`.Kundennummer AND `Artikel$`.Kundennummer = `Umsatz$`.Kundennummer"
 
 With CreateObject("ADODB.Recordset")
   .Open c00, "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0"""
   Sheet9.Cells(1).CopyFromRecordset .DataSource
 End With

 MsgBox Timer - t1
End Sub

Hallo snb,

ist das hier eine eigene Variante die einfach nochmals schneller ist als die untenstehende Variante?
Das in c00 = schaut aus wie ein SQL Statement, ist hier die Reihenfolge der Spalten entscheidend? Das schaut danach aus, dass dies hier bereits die Reihenfolge ist welche am Ende der Abfrage herauskommen soll?
Warum steht zB hier (G:\OF\__Beispieldatei.xlsb`.`Artikel$` `Artikel$`,) das Artikel$ zweimal in der Abfrage? Ist es hier aus Performancegründen optimaler wenn es sich um *.xlsb Dateien handelt?

Wo passiert hier der tatsächliche Abgleich und was ist das ADODB.Recordset?

23 Sek. :

Code:

Sub M_snb()
  t1 = Timer
 
  Dim sp(3 * 10 ^ 5, 10)
    
  With CreateObject("scripting.dictionary")
    For j = 1 To 3
      sn = Sheets(Choose(j, "Umsatz", "Artikel", "Besuche")).Cells(1).CurrentRegion
      For jj = 2 To UBound(sn)
        If Not .exists(sn(jj, 1)) Then .Item(sn(jj, 1)) = .Count
        
        y = .Item(sn(jj, 1))
        For jjj = 1 To 5
          sp(y, Choose(jjj, 0, 1, 1 + j, 4 + j, 7 + j)) = sn(jj, jjj)
        Next
      Next
    Next
    
    Sheet9.Cells(1).Resize(.Count, 10) = sp
  End With

  MsgBox Timer - t1
End Sub

Mann kan auch händsich ein Querytable machen.

Hier würde mich interessieren würde was das hier ist?

Dim sp(3 * 10 ^ 5, 10)

Bzw. auch wie dieses ScriptingDictionary funktioniert?

CreateObject("scripting.dictionary")

Und was mich noch interessieren würde ist wo hier die Reihenfolge der Spalten definiert wird?

Danke und lg

Olli

[snb]

Das sind 2 verschiedene Varianten.

ADO ist ein VBA 'library' die man verwenden kann (wie z.B. createobject("scripting.filesytemobject')).
Weil diese 'library' nicht standard geladen ist, muss sie geladen werden mit 'createobject'.

Die Reihenfolge der Spalten steht im SQL-string.

Die Code reicht für deine Frage.

Das einzige das du anpassen muss ist
- Erstelle ein neues Arbeitsblatt
- Ersetze 'sheet9' von der Codename des neuen Arbeitsblattes.

Code:

Sheet9.Cells(1).CopyFromRecordset .DataSource

Die Code kan in jeder Codemodule gespeichert werden.

[schauan]

Hallöchen,

dass das zwei mal die gleiche Bezeichnung hat, kann willkürlich gesetzt werden. Das zweite mal ist ein Alias, um die Quellangabe in der Abfrage abzukürzen. Ansonsten müsstest Du den Dateinamen immer wieder mit dazu schreiben. Bei gleicher Formulierung sieht man eventuell am Ende besser durch.

[Ego]

Hallo Olli,

wie schon geschrieben würde ich snb's Version nutzen. Seine letzte Version (nicht ADO) benötigt auf meinem Rechner < 17 Sekunden, hat aber den enormen Vorteil, dass die einzelnen Listen nicht sortiert sein müssen.

Achtung! Im Augenblick können sich die Ergebnisse unsere beiden Programme unterscheiden ( aber nicht mit deinen Beispieldaten).

A) Mein Programm durchläuft die Kundenliste und fügt im Ergebnis die passenden Daten der anderen drei Listen hinzu (ähnlich der Formellösung).
Hierbei werden Einträge aus den Einzellisten, die keine entsprechenden Eintrag in der Kundenliste haben ignoriert.

B) snb's Programme fügen passenden Einträge aus den drei Einzellisten zusammen.
Falls in der Kundenliste Kundennummern vorhanden sind, die in den Einzellisten nicht vorkommen, werden sie im Ergebnis nicht ausgewiesen.

!!!Man kann aber beide Programme ohne bemerkbare Erhöhung der Rechenzeit so anpassen, dass sie das gleiche von dir gewünschte Ergebnis liefern.

C) Man könnte die Programme auch so modifizieren dass sowohl alle Einträge aus der Kundenliste als auch alle Einträge aus den Einzellisten berücksichtigt werden.