Excelで2つの指定された日付の間に2時間ごとにすべての日付をリストする方法

Question

私の仕事では、Excelテーブルを処理して時間範囲の間にデータを収集する必要があります。

今まで私は、次のVBAコードを使用：

Sub WriteDates() 
'Updateby20150305 
Dim rng As Range 
Dim StartRng As Range 
Dim EndRng As Range 
Dim OutRng As Range 
Dim StartValue As Variant 
Dim EndValue As Variant 
xTitleId  = "KutoolsforExcel" 
Set StartRng = Application.Selection 
Set StartRng = Application.InputBox("Start Range (single cell):", xTitleId, StartRng.Address, Type: = 8) 
Set EndRng = Application.InputBox("End Range (single cell):", xTitleId, Type: = 8) 
Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type: = 8) 
Set OutRng = OutRng.Range("A1") 
StartValue = StartRng.Range("A1").Value 
EndValue  = EndRng.Range("A1").Value 
If EndValue - StartValue <= 0 Then 
    Exit Sub 
    End If 
    ColIndex = 0 
    For i = StartValue To EndValue 
     OutRng.Offset(ColIndex, 0) = i 
     ColIndex = ColIndex + 1 
    Next 
End Sub 

をしかし、このコードは、時間によって全体の日とないの一覧を表示することができます。

たとえば、01.01.2017から03.01.2017の間の日付範囲を入力して01.01.2017 02:00、次に01.01.2017 04:00などと... 02.01.2017 22:00までを入力すると。

私はこのコードを編集するのに数回試しましたが、毎回それを壊しました。私はまた、入力ボックスを削除して、セルB2とC2から時間範囲を読み取るコードとA17で出力するが、もう一度は成功しないようにしました。

私はプログラマーではないので、私はVBAについて少し読んでみましたが、多くのことを学ぶ必要があることを理解しました。

誰かがこれを試したことや、助けを知っている場合、私は非常に感謝します。

Answer 1

あなたが持っているコードは、forループ= "For i = StartValue To EndValue"を使用して値を生成するので、2時間間隔を入力する場所はありません。私のコードでは、endDateとstartDateを使って、endDate-startDateに12を掛けて必要な行の数を計算します。 3時間後に、forループを値がendDateに達したかどうかをチェックするwhileループに変更することができます。

Sub WriteDates() 
'Updateby20150305 
Dim rng As Range 
Dim StartRng As Range 
Dim EndRng As Range 
Dim OutRng As Range 
Dim StartValue As Variant 
Dim EndValue As Variant 
xTitleId = "KutoolsforExcel" 
Set StartRng = Application.Selection 
Set StartRng = Application.InputBox("Start Range (single cell):", xTitleId, StartRng.Address, Type:=8) 
Set EndRng = Application.InputBox("End Range (single cell):", xTitleId, Type:=8) 
Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8) 
Set OutRng = OutRng.Range("A1") 
StartValue = StartRng.Range("A1").Value 
EndValue = EndRng.Range("A1").Value 
If EndValue - StartValue <= 0 Then 
    Exit Sub 
    End If 
    ColIndex = 0 
    intRows = (EndValue - StartValue) * 12 ' number of times you need to loop to get 2 hour intervals 24/2 
    OutRng.Offset(0, 0) = StartValue ' put start value in the range 
    OutRng.Offset(0, 0).NumberFormat = "dd/mm/yyyy hh:mm" 'set the format 
    For RowIndex = 1 To intRows ' loop from 1 to intRows 
     OutRng.Offset(RowIndex, 0) = OutRng.Offset(RowIndex - 1, 0) + CDate("02:00:00") 'put the value above + 2 hours 
     OutRng.Offset(RowIndex, 0).NumberFormat = "dd/mm/yyyy hh:mm" ' set the format so that you can see the hours 
    Next 
End Sub 

エクセルで式を使用することもできます。期間をA1セル（02:00）に入れ、開始日をB1（01/02/2017）に、終了日をB2（01/03/2017）、次にB6をEnter = B1、B7 = IFERRORあなたがあなたのリストに必要と思うほど安全であると思う限り、IF（B6 + $ A $ 1 < = $ B $ 2、B6 + $ A $ 1、 ""）、 ""）オートフィルB7。 A1、B1、またはB2で何かを変更すると、リストが自動的に更新されます。

Answer 2

時間単位を指定できる特別な入力ボックスを追加するコードです。値が0の場合、デフォルトは1日間隔になります。空白のセル、負の値などをエラーチェックで追加するために残しておきます。

このアルゴリズムは、日付と時刻を日と分数として格納するという事実に基づいています。だから1時間= 1/24。 For...Nextループはstep valueの整数を必要とするため、Iという連続した値を生成するために24を掛けた後、24で除算して目的の値を出力します。

---

Option Explicit 

Sub WriteDates() 
'Updateby20150305 
Dim rng As Range 
Dim StartRng As Range 
Dim EndRng As Range 
Dim OutRng As Range 

Dim IntvlHrsRng As Range 
Dim IntvlHrs As Long 

Dim StartValue As Variant 
Dim EndValue As Variant 
Const xTitleId As String = "KutoolsforExcel" 
Dim ColIndex As Long 
Dim I As Long 
Set StartRng = Application.Selection 
Set StartRng = Application.InputBox("Start Range (single cell):", xTitleId, StartRng.Address, Type:=8) 
Set EndRng = Application.InputBox("End Range (single cell):", xTitleId, Type:=8) 

Set IntvlHrsRng = Application.InputBox("Interval (Hours) (singlecell)", xTitleId, Type:=8) 

Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8) 

Set OutRng = OutRng.Range("A1") 

StartValue = StartRng.Range("A1").Value 
EndValue = EndRng.Range("A1").Value 
IntvlHrs = IntvlHrsRng.Range("A1").Value 
    If IntvlHrs = 0 Then IntvlHrs = 24 

If EndValue - StartValue <= 0 Then 
    Exit Sub 
    End If 
    ColIndex = 0 

    For I = StartValue * 24 To EndValue * 24 Step IntvlHrs 
     OutRng.Offset(ColIndex, 0) = I/24 
     ColIndex = ColIndex + 1 
    Next I 

End Sub 

---