Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1488to1492
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
VBA Code schneller machen
16.04.2016 10:17:51
Heli
Hallo zusammen,
habe eine Frage zu VBA Code schneller machen:
Aus einen Tabellenblatt füge ich Daten in meine Active.Sheet ein: ca. 110.000 Zeilen
mit drei Datenspalten. Dauer 2 Sec.
Danach wird eine eine Loop durchlaufen die diese Daten nach PEN = Nummer für Daten,
tag_dat = Tag, stunde_dat = Stunde, und wert_dat = Wert in eine wert_dat schreibt.
das Dauer mir zu lange ca. 30 sec.
Frage gibt es einen Weg da schneller zu machen und Wie ?
Haben den Code mal unten eingefügt.
Das ist nur der wesentliche Teil, Also:
Daten aus Tabellle einlesen in wert_dat und dann immer wieder aufdrösseln in die einzelnen von mir gebrauchten Wertepaarungen.
Danke im Voraus !!
CODE:
'daten einlesen
zeile = -1
pen = 0
Do
zeile = zeile + 1
Offset = anzahl + 5 + zeile
pen_dat = Cells(Offset, 1)
tag_dat = Day(Cells(Offset, 2))
stunde_dat = Hour(Cells(Offset, 2))
wert_dat = Cells(Offset, 3)
wert(pen_dat, tag_dat, stunde_dat) = wert_dat
Loop Until pen_dat = ""
'varMeinArray = Range("A65:D:D").Value
'Sheets("Tabelle2").Range("A65:D:D") = varMeinArray
'Tabellenblatt auswählen
blatt = Right(Str(gastag_faktor), Len(Str(gastag_faktor)) - 1)
Sheets(blatt).Select
'If Cells(5, 1) > 0 Then
'Text = "Blatt " + blatt + " wurde bereits erzeugt" + Chr$(13) + "Zum nochmaligen erzeugen Datum in Zelle A5 löschen und Bericht nochmal auf 'Tabelle1' erzeugen" + Chr$(13) + "Ausserdem bereits erzeugte Datei " + blatt + " löschen" + Chr$(13) + Chr$(13) + "ACHTUNG Daten werden dann überschrieben"
'MsgBox (Text)
' GoTo ende
'End If
'Daten füllen
'cells(Zeile, Spalte)
Cells(5, 1) = gastag
'Kavernen Drücke+Temp
zeile = 9
spalte = 0
x = Day(gastag)
For h = 6 To 23
For p = 0 To 7
Cells(zeile, 2 + spalte) = wert(p, x, h)
spalte = spalte + 1
Next p
spalte = 0
zeile = zeile + 1
Next h
x = Day(gastag + 1)
For h = 0 To 5
For p = 0 To 7
Cells(zeile, 2 + spalte) = wert(p, x, h)
spalte = spalte + 1
Next p
spalte = 0
zeile = zeile + 1
Next h
'zähler
'OGE Ein
zeile = 9
spalte = 0
x = Day(gastag)
For h = 6 To 23
For p = 29 To 32
Cells(zeile, 16 + spalte) = wert(p, x, h)
spalte = spalte + 1
Next p
spalte = 0
zeile = zeile + 1
Next h
x = Day(gastag + 1)
For h = 0 To 6
For p = 29 To 32
Cells(zeile, 16 + spalte) = wert(p, x, h)
spalte = spalte + 1
Next p
spalte = 0
zeile = zeile + 1
Next h
'TGNW Ein
zeile = 9
spalte = 0
x = Day(gastag)
For h = 6 To 23
For p = 33 To 36
Cells(zeile, 27 + spalte) = wert(p, x, h)
spalte = spalte + 1
Next p
spalte = 0
zeile = zeile + 1
Next h

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Code schneller machen
16.04.2016 14:06:18
Arthur
Hallo Heli.
Setze zu Beginn
Application.Screenupdating=False
und am Ende
Application.Screenupdating=True
, dann sollte ein kleiner Zeitgewinn drin sein.
Gruß, Arthur.

AW: VBA Code schneller machen
16.04.2016 14:13:30
Heli
Danke für den Hinweis,
hatte das schon eingefügt.
Habe diese Stellen von VBA Code nicht mit in meine Frage reinkopiert.
Ist es besser wenn man den ganzen Code reinkopiert ?

AW: VBA Code schneller machen
16.04.2016 15:44:07
Michael
Hi zusammen,
es ist besser, den ganzen Code reinzukopieren und noch viel besser, eine Beispieldatei hochzuladen.
Dann läßt sich das nämlich sauber bearbeiten und testen...
So wie es jetzt ist, sehen wir nämlich nicht, welche Variablen wie deklariert sind (wenn überhaupt) und vor allem, welche Werte sie zur Laufzeit haben (z.B. anzahl, wert(), gastag).
Vorschlag 1:
zeile = -1
pen = 0
Do
zeile = zeile + 1
Offset = anzahl + 5 + zeile
pen_dat = Cells(Offset, 1)
tag_dat = Day(Cells(Offset, 2))
stunde_dat = Hour(Cells(Offset, 2))
wert_dat = Cells(Offset, 3)
wert(pen_dat, tag_dat, stunde_dat) = wert_dat
Loop Until pen_dat = ""
Warum nicht den ganzen Bereich in ein Array einlesen, das ist EIN Befehl bzw. Zugriff auf die Tabelle, und dann wert aus diesem Array füllen?
Ok, das sind doch beachtliche Datenmengen, aber eine kleine Optimierung wäre, Cells(Offset, 2) zunächst in eine Variable einzulesen und aus dieser die zwei gewünschten Werte zu extrahieren, also etwa so:
'statt
tag_dat = Day(Cells(Offset, 2))
stunde_dat = Hour(Cells(Offset, 2))
'eher
Tag2 = Cells(Offset, 2)
tag_dat = Day(Tag2)
stunde_dat = Hour(Tag2)

Dadurch sparst Du pro Schleife einen Zugriff auf eine Zelle.
Die reine Arithmetik schlägt zwar zeitmäßig nicht so zu Buche, aber die Konstruktion
zeile = -1
pen = 0
Do
zeile = zeile + 1
Offset = anzahl + 5 + zeile

läßt sich mit weniger Rechenaufwand so formulieren:
zeile = -1
pen = 0
Offset = anzahl + 5 + zeile
Do
Offset = Offset + 1
Zu den Schleifen selbst: teste mal die beiden Varianten...
Option Explicit
Sub test()
Dim gastag As Date
Dim x As Integer
Dim zeile&, spalte&, h&, p&
Dim t0 As Single, t1 As Single
gastag = "01.04.2016"
Cells.Clear
Cells(5, 1) = gastag
t0 = Timer
'Kavernen Drücke+Temp
zeile = 9
spalte = 0
x = Day(gastag)
For h = 6 To 23
For p = 0 To 7
'Cells(zeile, 2 + spalte) = wert(p, x, h)
Cells(zeile, 2 + spalte).Value = "A: p/h " & p & "/" & h
spalte = spalte + 1
Next p
spalte = 0
zeile = zeile + 1
Next h
t1 = Timer
MsgBox (t1 - t0) * 1000 & "ms"
End Sub
Sub testArr()
Dim gastag As Date
Dim x As Integer
Dim zeile&, spalte&, h&, p&
Dim zA&, sA&  ' zeile/spalte in array ausgabe
Dim Ausgabe() As Variant ' oder was Du halt für Werte hast
Dim t0 As Single, t1 As Single
gastag = "01.04.2016"
Cells.Clear
Cells(5, 1) = gastag
t0 = Timer
'Kavernen Drücke+Temp
zeile = 9
spalte = 0
x = Day(gastag)
ReDim Ausgabe(1 To 18, 1 To 8)
For h = 6 To 23
zA = h - 5
For p = 0 To 7
sA = p + 1
Ausgabe(zA, sA) = "B: p/h " & p & "/" & h
Next p
Next h
Cells(zeile, spalte + 2).Resize(UBound(Ausgabe, 1), UBound(Ausgabe, 2)) = Ausgabe
t1 = Timer
MsgBox (t1 - t0) * 1000 & "ms"
End Sub
Die untere rechnet viel weniger und greift insbesondere nicht bei JEDEM Wert auf die Tabelle zu: Einsparung in der Größenordnung 80%.
Wichtig für das Zurückkopieren ins Tabellenblatt ist, daß bei dem Redim der jeweilige Wert links vom "to" 1 ist. Vielleicht geht's auch anders, aber ich mag jetzt nicht rumprobieren...
Doch rumprobiert! Das ist möglicherweise sogar noch einen Ticken schneller:
Sub testArr2()
Dim gastag As Date
Dim x As Integer
Dim zeile&, spalte&, h&, p&
Dim Ausgabe() As Variant ' oder was Du halt für Werte hast
Dim t0 As Single, t1 As Single
gastag = "01.04.2016"
Cells.Clear
Cells(5, 1) = gastag
t0 = Timer
'Kavernen Drücke+Temp
zeile = 9
spalte = 0
x = Day(gastag)
ReDim Ausgabe(6 To 23, 0 To 7)
For h = 6 To 23
For p = 0 To 7
Ausgabe(h, p) = "C: p/h " & p & "/" & h
Next p
Next h
Cells(zeile, spalte + 2). _
Resize(UBound(Ausgabe, 1) - LBound(Ausgabe, 1) + 1, _
UBound(Ausgabe, 2) - LBound(Ausgabe, 2) + 1) = Ausgabe
t1 = Timer
MsgBox (t1 - t0) * 1000 & "ms"
End Sub
Schöne Grüße,
Michael

Anzeige
AW: VBA Code schneller machen
16.04.2016 16:36:29
Heli
Habe die Subs mal durchlaufen lassen
echt schnelle Dinger
Diesen Code habe ich mal eingepflegt:
bringt mir 50 % mehr Schnelligkeit !
super Danke !
'statt
tag_dat = Day(Cells(Offset, 2))
stunde_dat = Hour(Cells(Offset, 2))
'eher
Tag2 = Cells(Offset, 2)
tag_dat = Day(Tag2)
stunde_dat = Hour(Tag2)
~F~
Ich schicke mal den ganzen Code:
denn ich weiß nicht wie ich den
Sub testArr2() einbauen kann.
Bin halt Anfänger !!!
Ich habe in einem anderen Modul noch eine Umrechnung in Sommer/Winterzeit
die ich für die Zeilenverschiebung + 1Stunde brauche.
ich hänge den Hinter den <pre>Public Sub Makro1()
Hier der Code:
~F~
<pre>Public Sub Makro1()
'
' Makro1 Makro
'
' Tastenkombination: Strg+a
'
' Sheets("Tabelle1").Select
' Sheets("Tabelle2").Name = "Tab2"
Application.ScreenUpdating = False
On Error GoTo ERRORHANDLER
Dim datensatz(100) As Double
Dim wert_dat As Double
Dim datumsatz(100) As Date
Dim wert(100, 31, 24) As Double
Dim gastag As Date
Dim GültigSommerZeit As Boolean
GültigSommerZeit = IstGültigSommerZeit(Date) 'Aus Mudul Sommerzeit
If GültigSommerZeit = True Then
zeitverschiebung = 3 / 24 'Umrechnung Sommerzeit (3 Stunden obwohl 2 Stunden zurück zur kompensation:letzter wert der Vorstunde)
End If
If GültigSommerZeit = False Then
zeitverschiebung = 2 / 24 'Umrechnung Winterzeit (2 Stunden obwohl 2 Stunden zurück zur kompensation:letzter wert der Vorstunde)
End If
If GültigSommerZeit = True Then sPrompt = "Daten liegen in der Sommerzeit" ' Abfrage ob Sommer/Winterzeit in Modul Sommerzeit
If GültigSommerZeit = False Then sPrompt = "Daten liegen in der Winterzeit"
sDefault = Format(Date - 1, "dd.mm.yyyy")
gastag = InputBox(prompt:=sPrompt & Chr(13) & "Datum Gastag dd.mm.yy z.B. 05.10.14", Default:=sDefault)
'If gastag = "" Then Default = gastag
'gastag = InputBox("Datum Gastag dd.mm.yy z.B. 05.10.14", "Datum eingeben", Date - 1)
anzahl = Cells(2, 2)
gastag_faktor = Day(gastag) * 100 + Month(gastag)
gaszeitvon = DateAdd("h", 4, gastag)
gaszeitbis = gaszeitvon + 1
If Cells(2, 3) > gaszeitvon Then
MsgBox ("Rohdaten liegen nicht im richtigen Zeitbereich!1")
GoTo ende
End If
If Cells(2, 4) < gaszeitbis Then
MsgBox ("Rohdaten liegen nicht im richtigen Zeitbereich!2")
GoTo ende
End If
'Zeitverschiebung durchführen (Kurvenwerte sind immer 2 Stunden zurück, warum auch immer)
zeile_dat = -1
pen = 0
Do
zeile_dat = zeile_dat + 1
Offset = anzahl + 5 + zeile_dat
pen_dat = Cells(Offset, 1)
If Cells(Offset, 4) <> "x" Then 'prüfen ob Zeitverschiebungskorrektur bereits erfolgt ist
Cells(Offset, 2) = Cells(Offset, 2) + zeitverschiebung
Cells(Offset, 4) = "x" ' Flag für durchgeführte Zeitkorrektur
End If
Loop Until pen_dat = ""
'Zeitkorrektur Stundenarchive
'zeile_dat = -1
'pen = 0
'Do
'zeile_dat = zeile_dat + 1
' Offset = anzahl + 5 + zeile_dat
' pen_dat = Cells(Offset, 1)
' If Minute(Cells(Offset, 2)) = 59 Then
' Cells(Offset, 2) = Cells(Offset, 2) + 1 / 1440
' End If
'Loop Until pen_dat = ""
'daten einlesen
zeile = -1
pen = 0
Do
zeile = zeile + 1
Offset = anzahl + 5 + zeile
pen_dat = Cells(Offset, 1)
'statt
'tag_dat = Day(Cells(Offset, 2))
'stunde_dat = Hour(Cells(Offset, 2))
'eher
Tag2 = Cells(Offset, 2)
tag_dat = Day(Tag2)
stunde_dat = Hour(Tag2)
'tag_dat = Day(Cells(Offset, 2))
'stunde_dat = Hour(Cells(Offset, 2))
wert_dat = Cells(Offset, 3)
wert(pen_dat, tag_dat, stunde_dat) = wert_dat
Loop Until pen_dat = ""
varMeinArray = Range("A65:D:D").Value
Sheets("Tabelle2").Range("A65:D:D") = varMeinArray
'Tabellenblatt auswählen
blatt = Right(Str(gastag_faktor), Len(Str(gastag_faktor)) - 1)
Sheets(blatt).Select
'If Cells(5, 1) > 0 Then
'Text = "Blatt " + blatt + " wurde bereits erzeugt" + Chr$(13) + "Zum nochmaligen erzeugen Datum in Zelle A5 löschen und Bericht nochmal auf 'Tabelle1' erzeugen" + Chr$(13) + "Ausserdem bereits erzeugte Datei " + blatt + " löschen" + Chr$(13) + Chr$(13) + "ACHTUNG Daten werden dann überschrieben"
'MsgBox (Text)
' GoTo ende
'End If
'Daten füllen
'cells(Zeile, Spalte)
Cells(5, 1) = gastag
'Kavernen Drücke+Temp
zeile = 9
spalte = 0
x = Day(gastag)
For h = 6 To 23
For p = 0 To 7
Cells(zeile, 2 + spalte) = wert(p, x, h)
spalte = spalte + 1
Next p
spalte = 0
zeile = zeile + 1
Next h
x = Day(gastag + 1)
For h = 0 To 5
For p = 0 To 7
Cells(zeile, 2 + spalte) = wert(p, x, h)
spalte = spalte + 1
Next p
spalte = 0
zeile = zeile + 1
Next h
'zähler
'OGE Ein
zeile = 9
spalte = 0
x = Day(gastag)
For h = 6 To 23
For p = 29 To 32
Cells(zeile, 16 + spalte) = wert(p, x, h)
spalte = spalte + 1
Next p
spalte = 0
zeile = zeile + 1
Next h
x = Day(gastag + 1)
For h = 0 To 6
For p = 29 To 32
Cells(zeile, 16 + spalte) = wert(p, x, h)
spalte = spalte + 1
Next p
spalte = 0
zeile = zeile + 1
Next h
'TGNW Ein
zeile = 9
spalte = 0
x = Day(gastag)
For h = 6 To 23
For p = 33 To 36
Cells(zeile, 27 + spalte) = wert(p, x, h)
spalte = spalte + 1
Next p
spalte = 0
zeile = zeile + 1
Next h
x = Day(gastag + 1)
For h = 0 To 6
For p = 33 To 36
Cells(zeile, 27 + spalte) = wert(p, x, h)
spalte = spalte + 1
Next p
spalte = 0
zeile = zeile + 1
Next h
'TGM Ein
zeile = 9
spalte = 0
x = Day(gastag)
For h = 6 To 23
For p = 37 To 40
Cells(zeile, 38 + spalte) = wert(p, x, h)
spalte = spalte + 1
Next p
spalte = 0
zeile = zeile + 1
Next h
x = Day(gastag + 1)
For h = 0 To 6
For p = 37 To 40
Cells(zeile, 38 + spalte) = wert(p, x, h)
spalte = spalte + 1
Next p
spalte = 0
zeile = zeile + 1
Next h
'OGE Aus
zeile = 73
spalte = 0
x = Day(gastag)
For h = 6 To 23
For p = 41 To 44
Cells(zeile, 16 + spalte) = wert(p, x, h)
spalte = spalte + 1
Next p
spalte = 0
zeile = zeile + 1
Next h
x = Day(gastag + 1)
For h = 0 To 6
For p = 41 To 44
Cells(zeile, 16 + spalte) = wert(p, x, h)
spalte = spalte + 1
Next p
spalte = 0
zeile = zeile + 1
Next h
'TGNW Aus
zeile = 73
spalte = 0
x = Day(gastag)
For h = 6 To 23
For p = 45 To 48
Cells(zeile, 27 + spalte) = wert(p, x, h)
spalte = spalte + 1
Next p
spalte = 0
zeile = zeile + 1
Next h
x = Day(gastag + 1)
For h = 0 To 6
For p = 45 To 48
Cells(zeile, 27 + spalte) = wert(p, x, h)
spalte = spalte + 1
Next p
spalte = 0
zeile = zeile + 1
Next h
'TGM Aus
zeile = 73
spalte = 0
x = Day(gastag)
For h = 6 To 23
For p = 49 To 52
Cells(zeile, 38 + spalte) = wert(p, x, h)
spalte = spalte + 1
Next p
spalte = 0
zeile = zeile + 1
Next h
x = Day(gastag + 1)
For h = 0 To 6
For p = 49 To 52
Cells(zeile, 38 + spalte) = wert(p, x, h)
spalte = spalte + 1
Next p
spalte = 0
zeile = zeile + 1
Next h
'glykoltank Kavernen
zeile = 101
x = Day(gastag + 1)
h = 6
Cells(zeile, 2) = wert(8, x, h)
Cells(zeile, 4) = wert(9, x, h)
Cells(zeile, 6) = wert(9, x, h)
Cells(zeile, 8) = wert(10, x, h)
'PIR02 Ringraum Kavernen
zeile = 99
x = Day(gastag + 1)
h = 6
Cells(zeile, 2) = wert(53, x, h)
Cells(zeile, 4) = wert(54, x, h)
Cells(zeile, 6) = wert(55, x, h)
Cells(zeile, 8) = wert(56, x, h)
'Kondensat Frischglykol
x = Day(gastag + 1)
h = 6
Cells(107, 4) = wert(28, x, h)
Cells(106, 4) = wert(27, x, h)
'Taupunkt Entnahme
x = Day(gastag + 1)
h = 6
Cells(100, 13) = wert(19, x, h)
Cells(101, 13) = wert(20, x, h)
Cells(102, 13) = wert(21, x, h)
Cells(103, 13) = wert(22, x, h)
'Notstrom (stunden,Zähler,Tank)
x = Day(gastag + 1)
h = 6
Cells(101, 44) = wert(57, x, h)
Cells(102, 44) = wert(58, x, h)
Cells(103, 44) = wert(59, x, h)
'Eigengas/Brenngas
x = Day(gastag)
h = 6
Cells(54, 13) = wert(23, x, h)
Cells(55, 13) = wert(24, x, h)
Cells(56, 13) = wert(25, x, h)
Cells(58, 13) = wert(26, x, h)
x = Day(gastag + 1)
h = 6
Cells(54, 20) = wert(23, x, h)
Cells(55, 20) = wert(24, x, h)
Cells(56, 20) = wert(25, x, h)
Cells(58, 20) = wert(26, x, h)
'Taupunkte und Brennwerte Ferngasleitung
x = Day(gastag + 1)
h = 6
Cells(38, 26) = wert(11, x, h)
Cells(38, 31) = wert(15, x, h)
Cells(38, 32) = wert(17, x, h)
Cells(39, 26) = wert(13, x, h)
Cells(39, 31) = wert(16, x, h)
Cells(39, 32) = wert(18, x, h)
aktuellerpfad = ActiveWorkbook.Path
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=aktuellerpfad & "\" & blatt & ".xlsx"
Windows("Tagesmeldung erzeugen.xlsm").Activate
Sheets(blatt).Select
Sheets(blatt).Copy Before:=Workbooks(blatt).Sheets(1)
ActiveWorkbook.Save
Application.DisplayAlerts = True
Windows("Tagesmeldung erzeugen.xlsm").Activate
Sheets("Tabelle1").Select
ActiveWorkbook.Save
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.ScreenUpdating = True
ERRORHANDLER:
GoTo ende
' MsgBox "Fehler Nr. " & Err & ": " & Error
Resume Next
ende:
End Sub</pre>
~F~
Sommer/Winterzeit
~F~
<pre>Public Function IstGültigSommerZeit(Datum As Date) As Boolean
Dim Jahr As Long
Jahr = Year(Datum)
If Datum >= SommerZeitBeginn(Jahr) And _
Datum < SommerZeitEnde(Jahr) Then
IstGültigSommerZeit = True
End If
End Function</pre>
<pre>Public Function SommerZeitBeginn(Jahr As Long) As Date
Dim Datum As Date
Dim WoTag As Long
If Jahr > 1900 And Jahr < 2100 Then
Datum = DateSerial(Jahr, 4, 1)
WoTag = Weekday(Datum, vbMonday)
Datum = Datum - WoTag
Else
'Datum = ""
End If
SommerZeitBeginn = Datum 'letzter Sonntag im März
End Function</pre>
<pre>Public Function SommerZeitEnde(Jahr As Long) As Date
Dim Datum As Date
Dim WoTag As Long
If Jahr > 1900 And Jahr < 2100 Then
Datum = DateSerial(Jahr, 11, 1)
WoTag = Weekday(Datum, vbMonday)
Datum = Datum - WoTag
Else
'Datum = ""
End If
SommerZeitEnde = Datum 'letzter Sonntag im Oktober
End Function</pre>

Anzeige
AW: VBA Code schneller machen
16.04.2016 19:33:48
Michael
Hi,
an der/den passenden Stelle/n bitte entsprechend ändern...
'Kavernen Drücke+Temp
zeile = 9
spalte = 0
x = Day(gastag)
' ersetze ****************
''For h = 6 To 23
''For p = 0 To 7
''Cells(zeile, 2 + spalte) = wert(p, x, h)
''spalte = spalte + 1
''Next p
''spalte = 0
''zeile = zeile + 1
''Next h
' durch ****************
ReDim Ausgabe(6 To 23, 0 To 7) ' das ReDim machst Du vor jeder neuen Schleife,
For h = 6 To 23                ' und zwar mit den jeweiligen Werten für h von..bis
For p = 0 To 7               ' und p von.. bis
Ausgabe(h, p) = wert(p, x, h)
Next p
Next h
' 1. Zeile Cells... ist die linke obere Ecke der Ausgabe
' 2. und 3. Zeile muß nicht verändert werden, sondern
' berechnet die Größe der zu schreibenden Daten automatisch
Cells(zeile, spalte + 2). _
Resize(UBound(Ausgabe, 1) - LBound(Ausgabe, 1) + 1, _
UBound(Ausgabe, 2) - LBound(Ausgabe, 2) + 1) = Ausgabe

Lies mal bitte http://www.online-excel.de/excel/singsel_vba.php?f=152
zum Thema Arrays.
Der Code ist sehr umfangreich und ohne Datei schwer zu bearbeiten.
Ich kann Dir nur empfehlen, ganz am Anfang des Moduls ein
option explicit
einzufügen, dann bist Du gezwungen, alle Variablen sauber zu deklarieren.
Es fehlen z.B.
Dim zeitverschiebung As Double
Dim anzahl As Long
Dim Tag2 As Long
Dim zeile_dat As Long, zeile As Long, spalte As Long
Dim z_offset As Long
Dim pen_dat As Variant
Dim tag_dat&, stunde_dat&, x&, h&, p&  ' & steht für as long
Dim t0 As Single, t1 As Single
Dim Ausgabe() As Variant ' bitte durch Double ersetzen
Schöne Grüße,
Michael
P.S.: Eigentlich sollte man die ersten drei Do .. Loop zusammenfassen; dann wird die Schleife nur EINMAL durchlaufen. Mit Datei würde ich's mir vielleicht ansehen...

Anzeige
AW: VBA Code schneller machen
17.04.2016 13:16:15
Heli
Habe den ~Sub testArr2()~
Code eingebaut.
Nur das mit der zeilenverschiebung habe ich händisch
eingetragen.
Laufzeit ist jetzt unter 10 sec.
bei 110.000 Datensätzen mit drei Spalten.
Das ist super !!!!
Danke für deine Hilfe
Grüße vom Anfänger.
'daten einlesen
zeile = -1
pen = 0
Do
zeile = zeile + 1
Offset = anzahl + 5 + zeile
pen_dat = Cells(Offset, 1)
Tag2 = Cells(Offset, 2)
tag_dat = Day(Tag2) + zeitverschiebung
stunde_dat = Hour(Tag2)
wert_dat = Cells(Offset, 3)
wert(pen_dat, tag_dat, stunde_dat) = wert_dat
Loop Until pen_dat = ""
'Tabellenblatt auswählen
blatt = Right(Str(gastag_faktor), Len(Str(gastag_faktor)) - 1)
Sheets(blatt).Select
Cells(5, 1) = gastag
'Kavernen Drücke+Temp
zeile = 9
spalte = 0
x = Day(gastag)
ReDim Ausgabe(6 To 23, 0 To 7) ' das ReDim machst Du vor jeder neuen Schleife,
For h = 6 To 23 ' und zwar mit den jeweiligen Werten für h von..bis
For p = 0 To 7 ' und p von.. bis
Ausgabe(h, p) = wert(p, x, h)
Next p
Next h
Cells(zeile, spalte + 2). _
Resize(UBound(Ausgabe, 1) - LBound(Ausgabe, 1) + 1, _
UBound(Ausgabe, 2) - LBound(Ausgabe, 2) + 1) = Ausgabe
zeile = 27
spalte = 0
x = Day(gastag + 1)
ReDim Ausgabe(0 To 5, 0 To 7) ' das ReDim machst Du vor jeder neuen Schleife,
For h = 0 To 5 ' und zwar mit den jeweiligen Werten für h von..bis
For p = 0 To 7 ' und p von.. bis
Ausgabe(h, p) = wert(p, x, h)
Next p
Next h
Cells(zeile, spalte + 2). _
Resize(UBound(Ausgabe, 1) - LBound(Ausgabe, 1) + 1, _
UBound(Ausgabe, 2) - LBound(Ausgabe, 2) + 1) = Ausgabe

Anzeige
very nice! Grüße zurück, Michael owT
17.04.2016 16:22:21
Michael

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige