كيفية الحصول على قيمة DatateIFF في المليين الثانية في VBA (Excel)؟

Question

أحتاج لحساب الفرق بين الطابع الزمني في المللي ثانية. لسوء الحظ، لا تقدم وظيفة DatedIFF-VBA هذه الدقة. هل يوجد اى اعمال فى الجوار؟

Answer 1

يمكنك استخدام الطريقة الموصوفة هنا كالآتي:-

إنشاء وحدة فئة جديدة تسمى StopWatchضع التعليمات البرمجية التالية في StopWatch وحدة الطبقة:

Private mlngStart As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long

Public Sub StartTimer()
    mlngStart = GetTickCount
End Sub

Public Function EndTimer() As Long
    EndTimer = (GetTickCount - mlngStart)
End Function

يمكنك استخدام التعليمات البرمجية كما يلي:

Dim sw as StopWatch
Set sw = New StopWatch
sw.StartTimer

' Do whatever you want to time here

Debug.Print "That took: " & sw.EndTimer & "milliseconds"

تصف الطرق الأخرى استخدام وظيفة Timer VBA ولكن هذا دقيق فقط إلى مائة ثانية (CENTISECOND).

Answer 2

إذا كنت بحاجة فقط إلى الوقت المنقضي في Centiseconds، فأنت لا تحتاج إلى API TickCount. يمكنك فقط استخدام طريقة VBA.Timer الموجودة في جميع منتجات Office.

Public Sub TestHarness()
    Dim fTimeStart As Single
    Dim fTimeEnd As Single
    fTimeStart = Timer
    SomeProcedure
    fTimeEnd = Timer
    Debug.Print Format$((fTimeEnd - fTimeStart) * 100!, "0.00 "" Centiseconds Elapsed""")
End Sub

Public Sub SomeProcedure()
    Dim i As Long, r As Double
    For i = 0& To 10000000
        r = Rnd
    Next
End Sub

Answer 3

GetTickCount وعداد الأداء مطلوبة إذا كنت ترغب في الذهاب للثواني الصغيرة .. بالنسبة للميلسيسينكون، يمكنك فقط استخدام شيء مثل هذا ..

'at the bigining of the module
Private Type SYSTEMTIME  
        wYear As Integer  
        wMonth As Integer  
        wDayOfWeek As Integer  
        wDay As Integer  
        wHour As Integer  
        wMinute As Integer  
        wSecond As Integer  
        wMilliseconds As Integer  
End Type  

Private Declare Sub GetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)  


'In the Function where you need find diff
Dim sSysTime As SYSTEMTIME
Dim iStartSec As Long, iCurrentSec As Long    

GetLocalTime sSysTime
iStartSec = CLng(sSysTime.wSecond) * 1000 + sSysTime.wMilliseconds
'do your stuff spending few milliseconds
GetLocalTime sSysTime ' get the new time
iCurrentSec=CLng(sSysTime.wSecond) * 1000 + sSysTime.wMilliseconds
'Different between iStartSec and iCurrentSec will give you diff in MilliSecs

Answer 4

تستطيع ايضا استخذام =NOW() صيغة calature في الخلية:

Dim ws As Worksheet
Set ws = Sheet1

 ws.Range("a1").formula = "=now()"
 ws.Range("a1").numberFormat = "dd/mm/yyyy h:mm:ss.000"
 Application.Wait Now() + TimeSerial(0, 0, 1)
 ws.Range("a2").formula = "=now()"
 ws.Range("a2").numberFormat = "dd/mm/yyyy h:mm:ss.000"
 ws.Range("a3").formula = "=a2-a1"
 ws.Range("a3").numberFormat = "h:mm:ss.000"
 var diff as double
 diff = ws.Range("a3")

Answer 5

الاعتذار عن استيقاظ هذا المنصب القديم، لكنني حصلت على إجابة:
اكتب وظيفة لميلي ثانية مثل هذا:

Public Function TimeInMS() As String
TimeInMS = Strings.Format(Now, "HH:nn:ss") & "." & Strings.Right(Strings.Format(Timer, "#0.00"), 2) 
End Function    

استخدم هذه الوظيفة في الفرعية:

Sub DisplayMS()
On Error Resume Next
Cancel = True
Cells(Rows.Count, 2).End(xlUp).Offset(1) = TimeInMS()
End Sub

Answer 6

إلى جانب الطريقة التي وصفها Adamralph (GetTickCount())، يمكنك ان تفعلها:

• باستخدام QueryPerformanceCounter() و QueryPerformanceFrequency() وظائف API.
  كيف يمكنك اختبار وقت التشغيل من رمز VBA؟
• أو، بالنسبة للبيئات دون الوصول إلى API Win32 (مثل VBScript)، هذا:
  http://ccrp.mvps.org/ (تحقق من قسم التنزيل ل Office Com القابل للتثبيت "Timer". إنها مجانية.)