VBAの時間を比較

Question

友人、

タイムスタンプが過去2分間+ 7時間以内にある場合は、列をスキャンしてコピー/ペーストしようとしています。タイムスタンプの日付部分は整列していないので、時刻を変更せずに同じ日付に変換する必要があります。ここで

は私のコードです：（0.704461794（一般的な形式）または1/0/00 16:54：

Sub Timecompare() 

Dim i As Integer 
Dim lRow As Integer 
Dim ws1 As Worksheet 
Dim ws2 As Worksheet 

Set ws1 = Sheets("Volm") 
Set ws2 = Sheets("Sheet2") 

'goal: 
'scan all rows in dataset 
'if cell time > current time - 2 minutes 
'copy pasta 

With ws1 
    'find the last row 
    lRow = .Cells(.Rows.Count, "E").End(xlUp).Row 
    'loop through all the rows 
    For i = 10 To lRow 
     'if the cell value is greater than time + 7 hours - 2 minutes then copy/paste the row to new sheet 
     If .Cells(i, 18).Value > Now + TimeSerial(7, 0, 0) - TimeSerial(0, 2, 0) Then 
      ''' just spitting out the values in the comparator above so I can see the results and why they aren't comparing properly ''' 
      ws2.Cells(i, 1).Value = .Cells(i, 18).Value 
      ws2.Cells(i, 2).Value = Now + TimeSerial(7, 0, 0) - TimeSerial(0, 2, 0) 
      Exit For 
     End If 
    Next i 

End With 

End Sub 

".Cells（I、18）.Valueの" 出力は次のようになります"Now + TimeSerial（7、0、0） - TimeSerial（0、2、0）"の出力は次のようになります：42467.75336（一般形式）または4/7/16 6:04 PM（日付形式）

日付形式）。

私は日付を気にしません。私が気にするのは、時間だけです。だから、 ".Cells（i、18）.Value"を同じ時間に今日に持っていく、またはNow（）+ 7時間 - 2分の日付を1/0/00に戻す方法がありますか？繰り返しますと、私はリンゴにリンゴを手に入れようとしているので、時間を比較することができます。

Answer 1

私は単に時間を抽出します：

upperTime = GetTime(Now + TimeSerial(7, 0, 0) - TimeSerial(0, 2, 0)) 

With ws1 
    For i = 10 To lRow 

     ' compare on the time only ' 
     If GetTime(.Cells(i, 18).Value) > upperTime Then 

      ' copy the time only ' 
      ws2.Cells(i, 1).Value = GetTime(.Cells(i, 18).Value) 

      ' copy the current date plus the time from the cell ' 
      ws2.Cells(i, 2).Value = GetDate(Now) + GetTime(.Cells(i, 18).Value) 

      Exit For 
     End If 
    Next i 
End With 

日付部分または時刻部分を抽出する機能：時間を再構築して、今日の日付を使用する

' Returns the date part from a date/time ' 
Public Function GetTime(datetime As Date) As Date 
    GetTime = datetime - VBA.Fix(datetime) 
End Function 

' Returns the time part from a date/time ' 
Public Function GetDate(datetime As Date) As Date 
    GetDate = VBA.Fix(datetime) 
End Function 

Answer 2

変数を作成し、ループの外側にNow + TimeSerial(7, 0, 0) - TimeSerial(0, 2, 0)を割り当てます。ループ内の式の代わりにその変数を使用する（私が見ることができる2つの場所）

別の変数を作成し、today（）をループ外に割り当てます。比較には.Cells(i, 18).Value + <That Variable>を使用してください。このマクロの実行が深夜に及ぶと思わない場合は、変数を使用する代わりにtoday（）を直接使用することができます。

Answer 3

あなたのアルゴリズムは真夜中の交差点を考慮する必要があると思います。これは一見、ご希望の結果が得られます

Option Explicit 

Sub test() 
    Dim pastLimit As Date 
    Dim futureLimit As Date 
    Dim timestamps() As Variant 
    Dim testtime As Variant 

    timestamps = Array(DateValue("4/7/2016") + TimeValue("12:43:00 PM"), _ 
         DateValue("4/7/2016") + TimeValue(" 1:43:00 PM"), _ 
         DateValue("4/7/2016") + TimeValue(" 2:43:00 PM"), _ 
         DateValue("4/7/2016") + TimeValue(" 3:43:00 PM"), _ 
         DateValue("4/7/2016") + TimeValue(" 4:43:00 PM"), _ 
         DateValue("4/7/2016") + TimeValue(" 5:43:00 PM")) 

    pastLimit = Now + TimeSerial(0, 2, 0) 
    futureLimit = Now + TimeSerial(7, 0, 0) - TimeSerial(0, 2, 0) 

    For Each testtime In timestamps 
     If (testtime > pastLimit) And (testtime < futureLimit) Then 
      Debug.Print "in the window: " & Format(testtime, "hh:mm:ss ampm") 
     End If 
    Next testtime 

End Sub 

：（あなたのコードサンプル上記の）問題の文言に基づいて、私は次のテストを試してみました。