AW: lade besser hier ein Beispiel hoch...
15.07.2010 17:15:27
fcs
Hallo Jens,
hier eine Variante. Die in die Tabelle zu schreibenden Daten werden in einem 2. Array zwischengespeichert und zum Schluss auf einen Schalg in die Tabelle geschrieben. Das ist zumindest schneller als Einzelwertübertragung.
Wie sich die Geschwindigkeit bei 400000 zu verarbeitenden Zeilen verhält - ?
Gruß
Franz
Option Explicit
' minimum tilted global radiation for starting eta calculation
Const cEpsRad As Double = 0.1
Public Type typeTLFSOutput
TLFSDate As Date
TLFSTime As Date
rad As Double
teTank As Double
teAmb As Double
deltaT As Double
pumpOn As Integer
eta As Double
TLFSResult As Integer
End Type
Public Sub TLFS2_Pumpe_laeuft_nicht_trotz_Strahlung()
Dim iColDate As Integer, iColTime As Integer
Dim iColGlobRad As Integer, iColTeAmb As Integer
Dim iColDmndPump As Integer, iColTankLow As Integer
Dim dDeltaT As Double
Dim dEta As Double
Dim dEta0 As Double, dk1 As Double, dk2 As Double, dHyst As Double
Dim dEtaWarn As Double, dEtaCrit As Double
Dim lRow As Long, lRow2 As Long, lRowMax As Long, lRowStart As Long, iRowStep As Integer
Dim sWksOutputName As String
Dim myOutput() As typeTLFSOutput
Dim arrTmp() As Variant
Dim lCntOutput As Long
Dim dTmp As Double, lTmp As Long
' INITIALISIERUNG
iColDate = 1
iColTime = 2
iColGlobRad = 4
iColTeAmb = 3
iColDmndPump = 15
iColTankLow = 17
lRowStart = 10
iRowStep = 5
dEta0 = Range("eta0").Value
dk1 = Range("k1_").Value
dk2 = Range("k2_").Value
dHyst = Range("Hyst").Value
dEtaWarn = Range("eta_warn").Value
dEtaCrit = Range("eta_crit").Value
sWksOutputName = "Output"
If ActiveSheet.Name = sWksOutputName Then
MsgBox "bitte Arbeitsblatt mit Daten aktivieren"
Exit Sub
End If
' DATEN EINLESEN + VERARBEITEN
lRowMax = Cells(lRowStart, iColDate).End(xlDown).Row
lRow = lRowStart
Debug.Print "Start Berechnung"
ReDim myOutput(1 To 1)
ReDim arrTmp(1 To CLng((lRowMax - lRowStart) / iRowStep), 1 To 9)
Do While lRow + iRowStep dEtaCrit, 2, IIf(.eta > dEtaWarn, 1, 0))
End If
End If
arrTmp(lCntOutput, 1) = .TLFSDate
arrTmp(lCntOutput, 2) = .TLFSTime
arrTmp(lCntOutput, 3) = .rad
arrTmp(lCntOutput, 4) = .teTank
arrTmp(lCntOutput, 5) = .teAmb
arrTmp(lCntOutput, 6) = .deltaT
arrTmp(lCntOutput, 7) = .pumpOn
arrTmp(lCntOutput, 8) = 100 * .eta
arrTmp(lCntOutput, 9) = .TLFSResult
End With
lRow = lRow + iRowStep
Loop
Debug.Print "Ende Berechnung"
' AUSGABE
Debug.Print
Debug.Print "Start Ausgabe"
Application.ScreenUpdating = False
Worksheets(sWksOutputName).Activate
ActiveSheet.UsedRange.ClearContents
' Ausgabe Überschriften
Range("B2").Select
With ActiveCell
.Offset(0, 0) = "Datum"
.Offset(0, 1) = "Zeit"
.Offset(0, 2) = "SP Einstrahlung"
.Offset(0, 3) = "TE Puffer unten"
.Offset(0, 4) = "TE ambient"
.Offset(0, 5) = "DT Puffer-Koll fiktiv"
.Offset(0, 6) = "D2 pump on?"
.Offset(0, 7) = "PC eta"
.Offset(0, 8) = "TLFS result"
End With
' Ausgabe Werte
Range("B3").Select
Debug.Print "Ende Ausgabe"
Range("B3").Resize(UBound(arrTmp, 1), UBound(arrTmp, 2)).Value = arrTmp
Columns(3).NumberFormat = "hh:mm:ss"
Cells.Columns.EntireColumn.AutoFit
Erase arrTmp
Erase myOutput
Application.ScreenUpdating = True
Debug.Print "fertig! :-)"
End Sub