AW: Diagrammdaten ein- und ausblenden
18.09.2020 15:56:48
fcs
Hallo Torsten,
auch nach fast 30 Jahren arbeiten mit Excel wird man immer mal wieder von kleinen Gemeinheiten überrascht.
Es gibt einen minimal negativen Wert von -5,29E-13 wenn unter VBA in der 1. Datenzeile (=Starzeit) die vom Makro berechnete Startzeit von der Summe aus Datum und Zeit abgezogen wird, um die Laufzeit zu berechnen. Hier kommt die Rechengenauigkeit von Excel ins Spiel.
Negative Werte können unter Excel aber nicht als Datum/Zeit angezeigt werden.
Im VBA-Editor wird zu diesem Zeitpunkt für die Variable datLaufzeit der Wert #00:00:00# angezeigt - alles scheint OK.
Warum es dann beim Eintragen des Wertes der Variablen in die Zelle zum Fehler kommt - das wissen (oder auch nicht) nur die Excel-Götter bei Microsoft.
Ich hab jetzt eine Fehler-Behandlung eingebaut, die in diesem Fall die Laufzeit auf 0 Sekunden setzt.
Noch 2 Hinweise:
Wenn du die Tabelle im Blatt "Daten" komplett leerst, dann musst du in den Pivot-Tabellenberichten das Feld "Laufzeit" ggf. neu gruppieren nach Stunden und Minuten.
Du musst die Daten der Messreihen im Blatt "Daten" nicht löschen, um bestimmte Tage im Diagramm zu vergleichen. Du kannst im Diagramm den Filter für das Datum auf die Tage setzen, die du vergleichen möchtest.
LG
Franz
Sub prcMesswerte_nach_Daten()
'Übertragung der Messwerte eines Tages ins Blatt Daten
Dim wksDaten As Worksheet
Dim wksMesswerte As Worksheet
Dim Zeile_M As Long, Zeile_D As Long, spa_M As Long
Dim datZeit0 As Date, datDatum As Date, datZeit As Date, datLaufzeit As Date, MP As Long
Dim iSh As Integer, arrSh() As String, sMsg As String
On Error GoTo Fehler
Set wksDaten = Worksheets("Daten")
With wksDaten
'letzte ausgefüllte Zeile in "Daten"
Zeile_D = .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(Zeile_D, 1) = "" Then
Zeile_D = Zeile_D - 1
End If
End With
For Each wksMesswerte In ActiveWorkbook.Worksheets
If IsDate(wksMesswerte.Name) Then
iSh = iSh + 1
ReDim Preserve arrSh(1 To iSh)
arrSh(iSh) = wksMesswerte.Name
sMsg = sMsg & vbLf & iSh & " = " & arrSh(iSh)
End If
Next
If iSh = 0 Then
MsgBox "Es gibr keine Blätter mit Datum als Name"
Else
iSh = InputBox("Bitte Nummer des gewünschten Datums eingeben" & sMsg, _
"Blatt mit Import-Daten wählen", 1)
Select Case Val(iSh)
Case 0 'Abgebrochen
Case 1 To UBound(arrSh)
Set wksMesswerte = ActiveWorkbook.Worksheets(arrSh(iSh))
With wksMesswerte
Zeile_M = 2
datZeit0 = .Cells(Zeile_M, 1).Value + .Cells(Zeile_M, 2).Value
MP = 0
For Zeile_M = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
datDatum = .Cells(Zeile_M, 1).Value
datZeit = .Cells(Zeile_M, 2)
datLaufzeit = datDatum + datZeit - datZeit0
MP = MP + 1
For spa_M = 4 To .Cells(1, .Columns.Count).End(xlToLeft).Column
If Trim(.Cells(Zeile_M, spa_M)) "" Then
Zeile_D = Zeile_D + 1
wksDaten.Cells(Zeile_D, 1) = datDatum
wksDaten.Cells(Zeile_D, 2) = datZeit
wksDaten.Cells(Zeile_D, 3) = datLaufzeit
wksDaten.Cells(Zeile_D, 4) = MP
wksDaten.Cells(Zeile_D, 5) = .Cells(1, spa_M).Text
wksDaten.Cells(Zeile_D, 6) = .Cells(Zeile_M, spa_M).Value
End If
Next
Next Zeile_M
End With
Case Else
MsgBox "ungültige Auswahl"
End Select
End If
'Fehler-Behandlung
Fehler:
With Err
Select Case .Number
Case 0 'alles ok
Case 1004
datLaufzeit = TimeSerial(0, 0, 0)
Resume
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
End Sub