PDA

View Full Version : time to decimal format



mbambusz
11-29-2017, 06:15 AM
Hi All,
I ńeed to convert the time of operation to decimal format, in minutes. So, let's say I have a column with values as 3m 46.8s or 11h 37m 31.6s, and I need to convert the values to decimal format, that means 3m 46.8s = 3.80833 etc. Please, help. Thank you
21085

Paul_Hossler
11-29-2017, 07:17 AM
I'd use a user defined function - paste the Function DecMinFromString into a standard module

if 1h 19m 37.8s is in A1, then in B1 =DecMinFromString(A1)





Option Explicit

Sub drv()
MsgBox DecMinFromString("1h 1m 30s")
MsgBox DecMinFromString("1h 30s")
MsgBox DecMinFromString("1m 30s")
MsgBox DecMinFromString("30m")
MsgBox DecMinFromString("15s")
End Sub

Function DecMinFromString(s) As Double
Dim Hours As Long, Mins As Long, Secs As Long
Dim nHours As Double, nMins As Double, nSecs As Double

'cleanup - don't assume spaces
s = Replace(s, " ", "")

Hours = InStr(s, "h")
If Hours > 0 Then
nHours = Left(s, Hours - 1)
s = Right(s, Len(s) - Hours)
End If

Mins = InStr(s, "m")
If Mins > 0 Then
nMins = Left(s, Mins - 1)
s = Right(s, Len(s) - Mins)
End If

Secs = InStr(s, "s")
If Secs > 0 Then
nSecs = Left(s, Secs - 1)
End If

DecMinFromString = 60# * nHours + nMins + nSecs / 60#
End Function

mbambusz
11-30-2017, 12:13 AM
Hi Paul,
I am affraid it doesn't work. See the image please. I have the excel 2010.
21088

mbambusz
11-30-2017, 12:25 AM
There is an error "value in the formula has an invalid data type"

21089

mbambusz
11-30-2017, 03:21 AM
Hi Paul, everything is OK. Thank you for your help

snb
11-30-2017, 06:08 AM
I had this in mind:


Sub M_snb()
MsgBox F_snb("1h 1m 30s")
MsgBox F_snb("1h 30s")
MsgBox F_snb("1m 30s")
MsgBox F_snb("30m")
MsgBox F_snb("15s")
End Sub

Function F_snb(s)
If InStr(s, "h") = 0 Then s = "0h " & s
If InStr(s, "s") = 0 Then s = s & " 0"
If InStr(s, "m") = 0 Then s = IIf(InStr(s, "h"), Replace(s, "h ", "h 0m "), "0h 0m " & s)

F_snb = CDate(Replace(Replace(Replace(s, "s", ""), "m ", ":"), "h ", ":"))
End Function

mbambusz
11-30-2017, 06:35 AM
Why are there MsgBoxes? I don't understand this,

I need to open the file, load data file and convert the column with time to decimal format (new column) so I had to use cycle "For"

mbambusz
11-30-2017, 06:37 AM
sorry for the comments in czech. Makro is started with opening the file, makro opens the file, loads the data and convert time from 1 column to new column and format. Cycle converting all rows.


Sub Auto_Open()
'
' import2 Makro
'
Dim DecMinFromString As Double
Dim s As String
Dim Hours As Long, Mins As Long, Secs As Long
Dim nHours As Double, nMins As Double, nSecs As Double, i As Byte, p As Long
'
ChDir "\\czlibefp01\users\michal.bambusz\dočasné (file://\\czlibefp01\users\michal.bambusz\dočasné)" 'definice složky

Cells.Select 'smazani predchiziho obsahu v celem listu
Selection.Delete Shift:=xlUp 'smazani predchiziho obsahu v celem listu

soubor = Application.GetOpenFilename("zdrojova data (*.csv),*.csv")
Application.ScreenUpdating = False 'zakaz překreslování obrazovky
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;\\czlibefp01\users\michal.bambusz\dočasné\november.csv", Destination:= _
Range("$A$1"))
.Name = "november"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
ActiveWindow.SmallScroll Down:=-12
Range("A1").Select

Columns("O:O").Select 'změna formátu čísla
Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

p = Range("A1").CurrentRegion.Rows.Count 'vrati pocet radku do p
Range("A1").Select
For i = 2 To p

s = Cells(i, 15).Value
If s = "" Then 'pokud je hodnota O = 0 pak preskoc dal
GoTo preskoc
End If

s = Replace(s, " ", "") 'mezery pryč

Hours = InStr(s, "h") 'nefunguje korektně vynulování, proč?
If Hours > 0 Then
nHours = Left(s, Hours - 1)
s = Right(s, Len(s) - Hours)
Else 'nutno dodat else, pak funguje OK
nHours = 0
End If

Mins = InStr(s, "m")
If Mins > 0 Then
nMins = Left(s, Mins - 1)
s = Right(s, Len(s) - Mins)
End If

Secs = InStr(s, "s")
If Secs > 0 Then
nSecs = Left(s, Secs - 1)
s = Right(s, Len(s) - Secs)
Else
nSecs = 0
End If
DecMinFromString = 60# * nHours + nMins + nSecs / 60#

Cells(i, 16) = DecMinFromString 'zapis hodnoty do bunky
' ActiveCell.Offset(1, 0).Select 'vybereme bunku ktera je o 1 radek nize, stejny sloupecek
preskoc:
Next i
' Range("q1").Select

End Sub

snb
11-30-2017, 07:05 AM
Messageboxes are only for illustration/demonstration purposes.
You can implement the function into any workbook and use it as an UDF.

p45cal
11-30-2017, 07:28 AM
You can probably get away with a worksheet formula to get this too.
Formula in cells B3:C3 is:
=TIMEVALUE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A3,"h",":"),"m",":"),"s","")," ",""))
and same formula multiplied by 1440 in D3:
=TIMEVALUE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A3,"h",":"),"m",":"),"s","")," ","")) * 1440
All copied down.
Fractional seconds data is retained.
21090

Paul_Hossler
11-30-2017, 07:36 AM
Why are there MsgBoxes? I don't understand this,

I need to open the file, load data file and convert the column with time to decimal format (new column) so I had to use cycle "For"

I added a driver macro 'drv' with msgbox's in order to test various combanations

You don't need them in your final version