Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1332to1336
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Scription Dictionary o.Ä. - Bitte um Unterstützung

Scription Dictionary o.Ä. - Bitte um Unterstützung
11.10.2013 16:14:20
Thorben
Moin liebe Excelgemeinde,
ich habe folgende Datei und dazu das Problem dass meine Formeln für die Zuordnung und fortschreibung der Daten nicht ausreichend performant sind und auch nicht mehr
von Excel händelbar, jedenfalls stürzt Excel jenseits der 50000 Zeilenmarke gerne mal ab.
Meine Versuche mit VBA sind ebenfalls nichtig und darum bitte ich euch um Hilfe.
Die Daten in der Matrix müssen fortlaufend erweitert werden ich kann mir gut vorstellen das ein Scription Dictionary oder eine andere performante VBA Lösung das schafft.
https://www.herber.de/bbs/user/87622.xlsm
Vielen Dank schon einmal im Voraus
MfG
Thorben

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Scription Dictionary o.Ä. - Bitte um Unterstützung
11.10.2013 17:35:04
grassshopper
Hallo,
so große Datenmengen können deutlich besser mit ner Datenbank verarbeitet werden. Hast Du das Office-Paket - also auch MS Access?
Hilft ne Pivot-Tabelle in Excel?
https://www.herber.de/bbs/user/87625.xlsm
Gruß,
grassshopper

Kreuztabelle usw. mit Dictionary
13.10.2013 11:50:55
Erich
Hi Thorben,
mein PC (mit XL2010) braucht ca. 1 Sekunde für 50.000 Sätze.
Auch das Verketten für Spalte Y wird besser gleich in VBA erledigt.
Probier mal

Option Explicit
Sub Kreuztab_Verkett()
Dim eDic  As Object, uDic As Object, lngQ As Long, arAQ, arHQ, arU
Dim arT() As Long, zz As Long, cc As Long, arK
Set eDic = CreateObject("Scripting.dictionary")
Set uDic = CreateObject("Scripting.dictionary")
With Sheets("2008-2013")                           ' Quelldaten
.Cells(1, 13) = Now - Date                                     ' nur für Test
lngQ = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
arAQ = .Cells(2, 1).Resize(lngQ)                ' Spalte A
arHQ = .Cells(2, 8).Resize(lngQ)                ' Spalte H
End With
With Sheets("Matrix")
lngQ = .Cells(1, .Columns.Count).End(xlToLeft).Column - 1
arU = .Cells(2, 2).Resize(, lngQ)
For cc = 1 To lngQ
uDic(arU(1, cc)) = cc                        ' Typen
Next cc
For zz = 1 To UBound(arAQ)
If eDic.Exists(arAQ(zz, 1)) Then
arT = eDic(arAQ(zz, 1))                   ' hole Eintrag
If Not arT(uDic(arHQ(zz, 1))) Then
arT(uDic(arHQ(zz, 1))) = True          ' Typ kommt vor
eDic(arAQ(zz, 1)) = arT                ' schreibe Eintrag
End If
Else
ReDim arT(1 To lngQ)
arT(uDic(arHQ(zz, 1))) = True             ' Typ kommt vor
eDic(arAQ(zz, 1)) = arT                   ' neuer Eintrag
End If
Next zz
arK = eDic.Keys
ReDim arE(0 To UBound(arK), 1 To lngQ + 1)
For zz = 0 To UBound(arK)
arT = eDic(arK(zz))
For cc = 1 To lngQ
If arT(cc) Then
arE(zz, cc) = arU(1, cc)                        ' Typ eintr.
If arE(zz, lngQ + 1)  "" Then _
arE(zz, lngQ + 1) = arE(zz, lngQ + 1) & ", " ' verketten
arE(zz, lngQ + 1) = arE(zz, lngQ + 1) & arU(1, cc)
End If
Next cc
Next zz                                                  ' Ausgabe
.Cells(3, 1).Resize(UBound(arK) + 1) = Application.Transpose(arK)
.Cells(3, 2).Resize(UBound(arK) + 1, lngQ + 1) = arE
End With
Sheets("2008-2013").Cells(2, 13) = Now - Date                     ' nur für Test
End Sub

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

Anzeige
Vielen lieben Dank Eric, MfG,alles ok...
14.10.2013 09:46:09
Thorben
Hallo Erich,
ich bedanke mich in allerhöchster Form bei Dir für Deine Hilfe.
Jetzt kann ich endlich mal meine Datenflut ad-hoc abrufen ohne mich Stunden über Stunden durch Berechnen und Copy Paste quälen zu müssen.
Folgende "Code" Ergebnisse für meine aktuellen Daten:
Nummern: 15000
Typen: 23
Datenquelle: 450.000
Diese Code wird also mit 345.000 zuzuordnenden Daten in einer Tabelle aus 450.000 Quellen in:
Minuten 0,39793981481489 fertig!
Da fehlen mir die Worte :-)
Nochmal vielen lieben Dank!
Grüße aus Bremen,
Thorben

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige