Public My, Fs
Set My = WScript
With My
Set Fs = .CreateObject("Scripting.FileSystemObject")
End With
Dim vbWCrLf, vbTc
Const vbWq = """"
vbWCrLf = vbCrLf & vbCrLf
vbTc = vbTab & vbCrLf
Dim sStartTime, sEndTime, ElapsedTime
Dim StartTime, EndTime
Dim strReport
strReport = "時間差異と平均時間取得テスト" & " " & vbWCrLf
Const sPar = 3
sStartTime = Now()
My.Sleep 6000
sEndTime = Now()
dtDiff sStartTime, sEndTime, sPar, ElapsedTime
iDT sStartTime,,,, 0, StartTime
iDT sEndTime,,,, 0, EndTime
strReport = strReport & "みなし処理回数 - " & sPar & " " & vbWCrLf
strReport = strReport & "開始-" & StartTime & " " & vbCrLf
strReport = strReport & "終了-" & EndTime & " " & vbCrLf
strReport = strReport & "経過-" & Join(ElapsedTime(0)," ") & " " & vbCrLf
strReport = strReport & "経過時間単純数値化-" & ElapsedTime(1) & " " & vbCrLf
strReport = strReport & "平均-" & Join(ElapsedTime(2)," ") & " " & vbCrLf
strReport = strReport & "平均時間単純数値化-" & ElapsedTime(3) & " "
Msgbox strReport & " ",,Fs.GetBaseName(My.ScriptName)
Set Fs = Nothing
My.Quit
Public Function iDT(tDateTime, dSplitter, dtSeparater, tSplitter, Control, Result)
Dim vDateTime, cDateTime, nD, nS, strYMD, strHNS
Dim dVal, cVar, arVar
dVal = Array(Now(),"/"," ",":",1)
cVar = Array(Array(tDateTime,7,False,dVal(0)),Array(dSplitter,10,True,dVal(1)), _
Array(dtSeparater,10,True,dVal(2)),Array(tSplitter,10,True,dVal(3)), _
Array(Control,2,False,dVal(4)))
arVar = VarChk(cVar)
tDateTime = arVar(0)
strYMD = FormatDateTime(DateValue(tDateTime),0)
nS = ":" & Split(CStr(FormatDateTime(tDateTime,3)),":")(2)
strHNS = FormatDateTime(tDateTime,4) & nS
If arVar(3) = dVal(3) Then
Else
strHNS = Replace(strHNS,dVal(3),arVar(3))
End If
If arVar(1) = dVal(1) Then
Else
strYMD = Cstr(Replace(strYMD,dVal(1),arVar(1)))
End If
If arVar(4) = dVal(4) Then
Result = Split(strYMD & "|" & strHNS,"|")
Else
Result = strYMD & arVar(2) & strHNS
End If
End Function
Function VarChk(arVar)
If VarType(arVar) >= 8192 Then
ReDim iResult(UBound(arVar))
Dim Pc, iVar, cVar ,vVar, vDT, cDT
Pc = 0
For Each iVar In arVar
cVar = VarType(iVar) >= 8192 And Ubound(iVar) = 3
If cVar Then
cVar = VarType(iVar(1)) = 2 And VarType(iVar(2)) = 11
If cVar Then
If iVar(1) = 8 Then
vDT = VarType(iVar(0))
cDT = vDT <> 10 And (vDT = 7 Or (vDT = 8 And IsDate(iVar(0))))
If cDT Then
iResult(Pc) = DateValue(iVar(0)) + TimeValue(iVar(0))
Else
iResult(Pc) = iVar(3)
End If
Else
vVar = VarType(iVar(0))
If iVar(2) = (vVar = iVar(1)) Then
iResult(Pc) = iVar(3)
Else
iResult(Pc) = iVar(0)
End If
End If
End If
End If
Pc = Pc + 1
Next
End If
VarChk = iResult
End Function
Function dtDiff(Before, After, Par, Result)
If VarType(Before) = 7 Then
Dim cVar, arVar, lDate, Diffs, avDiffs, iResult
cVar = Array(Array(After,7,False,Now()), Array(Par,2,False,1))
arVar = VarChk(cVar)
lDate = DateSerial(0,1,1)
Diffs = arVar(0) - Before
If arVar(1) > 0 Then
avDiffs = Diffs / arVar(1)
End If
Diffs = lDate + Diffs
avDiffs = lDate + avDiffs
iResult = Array( _
Array(Digit(Year(Diffs) - 2000, "0000"),Digit(Month(Diffs) - 1, "00"),Digit(Day(Diffs) - 1, "00")), _
Array(Digit(Hour(Diffs), "00"), Digit(Minute(Diffs),"00"), Digit(Second(Diffs),"00")), _
Array(Digit(Year(avDiffs) - 2000, "0000"),Digit(Month(avDiffs) - 1, "00"),Digit(Day(avDiffs) - 1, "00")), _
Array(Digit(Hour(avDiffs), "00"), Digit(Minute(avDiffs),"00"), Digit(Second(avDiffs),"00")))
Result = Array(Array(Join(iResult(0),"/"),Join(iResult(1),":")),Cdbl(Join(iResult(0),"") & Join(iResult(1),"")), _
Array(Join(iResult(2),"/"),Join(iResult(3),":")),Cdbl(Join(iResult(2),"") & Join(iResult(3),"")))
dtDiff = iResult
Else
dtDiff = False
End If
End Function
Function Digit(Num, dig)
Digit = Right(Clng("1" & dig) + Num, Len(Dig))
End Function
|
0 件のコメント:
コメントを投稿
注: コメントを投稿できるのは、このブログのメンバーだけです。