Eingrenzung des Bereichs der Bedingung/ Format

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

'makro in einem allgemeinen Modul - z.B der in der persönlichen Makro Arbeitsmappe Sub Zeittext_konvertieren() 'Zeittext hh:mm:ss:ms umwandeln in Excelzeit hh:mm:ss,000 Dim wks As Worksheet Dim Zelle As Range, varZeit As Variant, varMS, Spalte As Long Set wks = ActiveSheet Spalte = 1 ' Spalte A - Nummer der Spalte ggf. anpassen With wks 'in folgender Zeile die Startzeile 2 ggf. anpassen .Columns(Spalte).NumberFormat = "hh:mm:ss.000" For Each Zelle In .Range(.Cells(2, Spalte), .Cells(.Rows.Count, Spalte).End(xlUp)) varZeit = Zelle.Text varMS = Mid(varZeit, InStrRev(varZeit, ":") + 1) varZeit = Left(varZeit, 8) Zelle.Value = CDbl(CDate(varZeit)) + Val(varMS) / 1000 / 24 / 3600 Next End With End Sub

Hallo Franz,
ja das ist ja ziemlich cool! Danke schön... Ich hab schon lauter Knoten in meinen Gehirnwindungen :-).
Mit der Anzahl der Zeilen habe ich mich wohl nicht ausreichend ausgedrückt. Ich habe ca. 50Datensätze (tendenz steigen) mit 200 bis max. 500 Zeilen. Ich komme also zusammen auf über 10000 Zeilen bzw. fast 15000.
Ich habe noch eine extra Funktion gebastelt, mit der ich Fehler in den Zeiten herrausfinden kann (die funktioniert nur nach Ausführung des Makros). Ein Fehler ist, wenn die nächste Zeile nicht eine ms nach Ende der vorherigen beginnt. Dafür ist es aber wichtig, dass in Spalte C die Endzeitpunkte erhalten bleiben (also z.B. C5 nicht gleich B6 wird). Ist es auch möglich, die neu berechneten Daten in Tabelle 3 zu schreiben, damit meine Orginaldaten erhalten bleiben und ich damit trotzdem rechnen kann? Außerdem ist mir aufgefallen, dass bei den ms "nur" die 3te Stelle abgeschnitten ist, also die Daten der letzten Stelle verlohren gehen. Falls das nicht anders geht, bleibe ich liebe bei 3 Stellen (sonst kann ich ja auch die Fehler in den Zeiten nicht finden).
Dann habe ich noch ein weiteres Problem. Bei dem Programm, aus dem ich die Daten habe, gibt es maximal 29ms. Danach fängt die nächste ss an. Leider werden diese Zeilen trotzdem als Fehler angezeigt. Ich habe auch schon überlegt was ich machen könnte, bei der RECHTS Funktion bekomme ich aber bei 29 eine 04 zurück gegeben, kann das also nicht als Bedingung nehmen und den Fehler abzufangen.
Nachdem ich die SUMMENPRODUKT-Fuktion endlich verstanden hatte, habe ich auch versucht sie auf die neu berechneten Daten anzuwenden. Witzgerweise funktioniert die einfache Formel genauso mit meinen alten orginalen Daten wie die Komplizierte (siehe Spalte J). Nur mit den neu berechneten Daten funktioniert die einfache Formel nicht. Aber das ist ja nun dank deiner Berechnung auch nicht mehr wichtig, aber vielleicht interessant.
https://www.herber.de/bbs/user/91431.xlsm
Liebe Grüße
Sabine

Sub Formeln_und_Daten() 'restliche Daten kopieren und Formeln einfügen Dim wks_Q As Worksheet, wks_Z As Worksheet Dim Zelle As Range, varZeit As Variant, varMS, Spalte As Long, StatusCalc As Long Set wks_Q = ActiveWorkbook.Worksheets("Orginal Daten") Set wks_Z = ActiveWorkbook.Worksheets("Tabelle3") Spalte = 2 ' Spalte B - Nummer der Spalte ggf. anpassen 'Makrobremsen lösen With Application StatusCalc = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With With wks_Z .Cells(1, 4).Value = "leer" .Cells(1, 5).Value = "Kategorie" 'neue Zeile 2014-07-10 .Cells(1, 6).Value = "Intervall" .Cells(1, 7).Value = "Fehler in der Zeit" .Cells(1, 8).Value = "leer2" .Cells(1, 9).Value = "Entry-dezimal" .Cells(1, 10).Value = "Exit-dezimal" .Cells(1, 11).Value = "Delta-Dezimal" End With With wks_Q 'Spalte E (Kategorien) von Original nach Tabelle 3 kopieren .Range(.Cells(2, Spalte), .Cells(.Rows.Count, Spalte).End(xlUp)).Offset(0, 3).Copy _ wks_Z.Cells(2, 5) End With With wks_Z 'Zeitdiferenzen dezimal in Spalte K '=RUNDEN(I3-J2;9) With .Range(.Cells(3, Spalte), .Cells(.Rows.Count, Spalte).End(xlUp)).Offset(0, 9) .FormulaR1C1 = "=ROUND(RC[-2]-R[-1]C[-1],9)" ' .Calculate ' .Value = .Value End With 'Formel für Zeitvergleich in Spalte G einfügen '=WENN(K2=0;"Gleiche Zeiten";WENN(ODER(K2 = 0,000000116;K2 = 0,000008218);"OK";"Fehler"))) '0.000000116 = 0,01 Sekunden '0.000008218 = Exit endet auf :29, Entry endet auf :00 With .Range(.Cells(2, Spalte), .Cells(.Rows.Count, Spalte).End(xlUp)).Offset(0, 5) .FormulaR1C1 = "=IF(RC11=0,""Gleiche Zeiten"",IF(OR(RC11 = 0.000000116," _ & "RC11 = 0.000008218),""OK"",""Fehler""))" ' .Calculate ' .Value = .Value End With End With 'Makrobremsen zurücksetzen With Application .Calculation = StatusCalc .ScreenUpdating = True End With End Sub

Hallo Sabine,
mit PasteSpecial sollte es funktionieren, dass die Formelergebnisse ins Originalblatt kopiert werden.
"Einfach" kopieren funktioniert nicht, da die kopierten Formeln
Gruß
Franz

  With wks_Z
'Zeitdiferenzen dezimal in Spalte K
'=RUNDEN(I3-J2;9)
With .Range(.Cells(3, Spalte), .Cells(.Rows.Count, Spalte).End(xlUp)).Offset(0, 9)
.FormulaR1C1 = "=ROUND(RC[-2]-R[-1]C[-1],9)"
'      .Calculate
'      .Value = .Value
End With
'Formel für Zeitvergleich in Spalte G einfügen
'=WENN(K2=0;"Gleiche Zeiten";WENN(ODER(K2 = 0,000000116;K2 = 0,000008218);"OK";"Fehler")))
'0.000000116 = 0,01 Sekunden
'0.000008218 = Exit endet auf :29, Entry endet auf :00
With .Range(.Cells(2, Spalte), .Cells(.Rows.Count, Spalte).End(xlUp)).Offset(0, 5)
.FormulaR1C1 = "=IF(RC11=0,""Gleiche Zeiten"",IF(OR(RC11 = 0.000000116," _
& "RC11 = 0.000008218),""OK"",""Fehler""))"
.Calculate  'wichtig, damit Neu-Berechnung der Formeln vor dem Kopieren abgeschlossen ist
'      .Value = .Value
End With
'berechnete Werte (Fehler in Zeit) aus Spalte G nach Quelltabelle Spalte G kopieren.
Spalte = 7
.Range(.Cells(1, Spalte), .Cells(.Rows.Count, Spalte)).Copy
wks_Q.Cells(1, 7).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With

Alternativ kann man mit angepassten Formeln (Tabellenblatt in Formel mit eingebaut) auch direkt die Spalte G ins Quellblatt zurückkopieren.

  With wks_Z
'Zeitdiferenzen dezimal in Spalte K
'=RUNDEN(I3-J2;9)
With .Range(.Cells(3, Spalte), .Cells(.Rows.Count, Spalte).End(xlUp)).Offset(0, 9)
.FormulaR1C1 = "=ROUND(RC[-2]-R[-1]C[-1],9)"
'      .Calculate
'      .Value = .Value
End With
'Formel für Zeitvergleich in Spalte G einfügen
'=WENN(K2=0;"Gleiche Zeiten";WENN(ODER(K2 = 0,000000116;K2 = 0,000008218);"OK";"Fehler")))
'0.000000116 = 0,01 Sekunden
'0.000008218 = Exit endet auf :29, Entry endet auf :00
With .Range(.Cells(2, Spalte), .Cells(.Rows.Count, Spalte).End(xlUp)).Offset(0, 5)
.FormulaR1C1 = "=IF('" & wks_Z.Name & "'!RC11=0,""Gleiche Zeiten""," _
& "IF(OR('" & wks_Z.Name & "'!RC11 = 0.000000116,'" & wks_Z.Name & "'!RC11 " _
& "= 0.000008218),""OK"",""Fehler""))"
'      .Calculate
'      .Value = .Value
End With
'Formeln (Fehler in Zeit) aus Spalte G nach Quelltabelle Spalte G kopieren.
Spalte = 7
.Range(.Cells(1, Spalte), .Cells(.Rows.Count, Spalte)).Copy wks_Q.Cells(1, 7)
End With

Beliebteste Forumthreads (12 Monate)

Eingrenzung des Bereichs der Bedingung/ Format

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread