Schreibroutine seeehr langsam.

Bild

Betrifft: Schreibroutine seeehr langsam.
von: Pascal
Geschrieben am: 21.04.2005 18:16:41
Hallo,
ich lese mit einem Makro eine recht große Matrix aus und suche nach gemeinsamkeiten.
Nehmen wir an, er hat 1000 Felder gefunden, die er in ein Array schreibt. Zu jedem Feld gehören 5 Weitere Felder.
Anschließend werden diese 6000 Felder in ein anderes Tabellenblatt untereinander geschrieben.
Sheets("Grundeinstellungen").Cells(30, 12) = "Daten werden geschrieben"
With Sheets("Affinitätenliste 3")
For x = 1 To z
For y = 1 To 6
.Cells(x + 5, y) = output(x, y) ' alle Werte rausschreiben
Next y
.Cells(x + 5, 7) = output(x, 1) ' ersten Wert zusätzlich rausschreiben


Next x
Dies dauert mit dem obigem Code mehrere Minuten. Woran liegt das?
Muss leider um 18:30 weg. Antworten um den Zeitraum herum, kann ich dann erst um Mitternacht beantworten.
Vielen Dank für Eure Hilfe,
Gruß Pascal
Hier noch mal der gesamte Code
Variablen des Arrays dimensionieren
Dim Ar(256, 256)
Dim i(10), j(10)
Dim output(64000, 6)
Dim x, y, e, f, z
' N
e = Sheets("Grundeinstellungen").Cells(28, 5) 'Eingabefeld Schwellenwert min
f = Sheets("Grundeinstellungen").Cells(30, 5) 'Eingabefeld Schwelenwert max
z = 1 'Beginn Spalte Outputtabelle

' Aunzahl gefundene Abhängigkeiten auf Null setzen
Sheets("Grundeinstellungen").Cells(28, 20) = 0
' Array auslesen
For y = 8 To 245
For x = 3 To 245
If (Sheets("Affinität").Rows(y).Hidden = False And Sheets("Affinität").Columns(x).Hidden = False) Or Sheets("Affinität").Cells(y, 2) = 0 _
Then Ar(y, x) = Sheets("Affinität").Cells(y, x) Else Ar(y, x) = -1
Next x
Next y
' Algorhythmus
For y = 8 To 245
For x = 3 + (y - 7) To 246
If Ar(y, x) > e And Ar(y, x) < f Then
For i(1) = x + 1 To 245
If Ar(y, i(1)) > e And Ar(y, i(1)) < f And Ar(5 + i(1), x) > e And _
Ar(5 + i(1), x) < f Then
z = z + 1
output(z, 1) = Sheets("Affinität").Cells(7, x)
output(z, 2) = Ar(y, x)
output(z, 3) = Sheets("Affinität").Cells(7, y - 5)
output(z, 4) = Ar(y, i(1))
output(z, 5) = Sheets("Affinität").Cells(7, i(1))
output(z, 6) = Ar(5 + i(1), x)
Sheets("Grundeinstellungen").Cells(28, 20) = z - 1
End If
Next i(1)
End If
Next x
Next y

' Output rausschreiben
Sheets("Affinitätenliste 3").Range("A7:g64000").ClearContents
Sheets("Grundeinstellungen").Cells(30, 12) = "Daten werden geschrieben"
With Sheets("Affinitätenliste 3")
For x = 1 To z
For y = 1 To 6
.Cells(x + 5, y) = output(x, y) ' alle Werte rausschreiben
Next y
.Cells(x + 5, 7) = output(x, 1) ' ersten Wert zusätzlich rausschreiben


Next x
End With
Sheets("Grundeinstellungen").Cells(30, 12) = "Fertig"

Bild

Betrifft: AW: Schreibroutine seeehr langsam.
von: EtoPHG
Geschrieben am: 21.04.2005 18:22:12
Hallo Pascal,
Vielleicht hilft das:
Am Anfang und am Schluss einzufügen

Sub x()
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
'....    dein code
    
    Application.Calculation = xlCalculationAutomatic
    Application.Calculate
    Application.ScreenUpdating = True
End Sub

Gruss Hansueli
Bild

Betrifft: Das wars!
von: Pascal Klaus
Geschrieben am: 21.04.2005 18:26:31
Hi,
wow. von mehr als 10 Minuten auf ca. 10 Sekunden.
VIELEN DANK und beste Grüße,
Pascal
Bild

Betrifft: So eine Freude:)
von: Pascal
Geschrieben am: 21.04.2005 18:31:22
Habe die Zeilen gleich bei zahlreichen weiteren Makros eingefügt und siehe da!
Schnelleres ausführen, als man klicken kann!
Danke nochmal!
Pascal
Bild

Betrifft: AW: Das wars!
von: vergim
Geschrieben am: 22.04.2005 09:39:44
Wow, habs auch bei meinen Makros eingefügt und die Arbeitsmappe hat eine super "Performance" danke!!!
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Excel als Datenbank für Word - Probleme !!"