У меня есть небольшой проект, над которым я работаю, где у меня есть диапазон ячеек, которые имеют статус 1 или 0 для онлайн и оффлайн. Как лучше всего смотреть в диапазоне ячеек и go от «1» до следующего «1», взять дату и сделать простое вычитание из первоначальной даты офлайн в следующую. Я предполагаю, что -1 из этого значения будет время работы оборудования. Ниже приведена копия кода, который я использовал, и макет рабочего листа Excel, к которому он относится. Если есть какие-то лучшие методы, я весь в ушах. Все еще довольно плохо знаком с VBA, и я уверен, что то, что я написал, не является лучшей практикой.
Sub StatsRunner()
Dim weekStartDate As Date
Dim weekEndDate As Date
Dim monthEndDate As Date
Dim monthStartDate As Date
Dim augustStartDate As Date
Dim today As Date
Dim Rng As Range
Dim nextOnline As String
Dim nextOffline As String
weekStartDate = Now - 7
weekEndDate = Now + 1
monthEndDate = Now
monthStartDate = Now - 30
'43678 corresponds to the numeric value for the data 8/1/2019
janStartDate = 43831
today = Now
rowHolder = 6
statsFirstRow = Worksheets("Stats").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Stats").Activate
ActiveSheet.Range("E6:R2000").ClearContents
For i = 6 To statsFirstRow
If Worksheets("Stats").Cells(i, 1).Value >= weekStartDate _
And Worksheets("Stats").Cells(i, 1).Value <= weekEndDate Then
Worksheets("Stats").Range("A" & i & ":B" & i).Copy
ActiveSheet.Range("E" & rowHolder & ":F" & rowHolder).Select
ActiveSheet.Paste
rowHolder = rowHolder + 1
End If
Next
'This is for a single instance of item in a column
weekEndRow = Worksheets("Stats").Cells(Rows.Count, 6).End(xlUp).Row
If Worksheets("Stats").Range("F" & weekEndRow).Value = 0 And weekEndRow = 6 Then
ActiveSheet.Range("P6").Value = 0
ElseIf Worksheets("Stats").Range("F" & weekEndRow).Value = 1 And weekEndRow = 6 Then
ActiveSheet.Range("P6").Value = 1
End If
'This next section tries to find the differences in each of the rows
weekFirstRow = Worksheets("Stats").Cells(Rows.Count, 6).End(xlUp).Row
For e = 6 To weekFirstRow
'Used to hold the column for the weeks section where there will be integer addition/subtraction
colHold = 6
'Reintializes 'c' for a totals variable
c = 0
a = ActiveSheet.Cells(e, 5).Value
If Application.WorksheetFunction.IsNumber(ActiveSheet.Range("F" & e + 1).Value) = True Then
b = ActiveSheet.Cells(e + 1, 5).Value
c = b - a
ActiveSheet.Range("L" & e).Value = c
Else:
b = Now
c = b - a
ActiveSheet.Range("L" & e).Value = c
End If
End If
' Else:
' ActiveSheet.Range("L6").Value = 0
' ActiveSheet.Range("P6").Value = 0
'
' End If
Next
'------------MONTH ITERATION-----------------------------------------
rowHolder = 6
For i = 6 To statsFirstRow
If Worksheets("Stats").Cells(i, 1).Value >= monthStartDate _
And Worksheets("Stats").Cells(i, 1).Value <= monthEndDate Then
Worksheets("Stats").Range("A" & i & ":B" & i).Copy
ActiveSheet.Range("G" & rowHolder & ":H" & rowHolder).Select
ActiveSheet.Paste
rowHolder = rowHolder + 1
End If
Next
monthFirstRow = Worksheets("Stats").Cells(Rows.Count, 8).End(xlUp).Row
For f = 6 To monthFirstRow
c = 0
If monthFirstRow > 6 And Worksheets("Stats").Cells(6, 8) = 1 Then
If Worksheets("Stats").Cells(f, 8).Value = 1 Then
a = ActiveSheet.Cells(f, 7).Value
If Application.WorksheetFunction.IsNumber(ActiveSheet.Range("H" & f + 1).Value) = True Then
b = ActiveSheet.Cells(f + 1, 7).Value
c = b - a
ActiveSheet.Range("M" & f).Value = c
Else:
b = Now
c = b - a
ActiveSheet.Range("M" & f + 1).Value = c
End If
End If
Else
ActiveSheet.Range("M6").Value = 0
ActiveSheet.Range("Q6").Value = 0
End If
Next
'Use DateDiff to find the total hrs of availability from Jan 1st to current date.
rowHolder = 6
For i = 6 To statsFirstRow
If Worksheets("Stats").Cells(i, 1).Value >= janStartDate _
And Worksheets("Stats").Cells(i, 1).Value <= today Then
Worksheets("Stats").Range("A" & i & ":B" & i).Copy
ActiveSheet.Range("I" & rowHolder & ":J" & rowHolder).Select
ActiveSheet.Paste
rowHolder = rowHolder + 1
End If
Next
janFirstRow = Worksheets("Stats").Cells(Rows.Count, 10).End(xlUp).Row
For g = 6 To janFirstRow
c = 0
If janFirstRow > 6 And Worksheets("Stats").Cells(6, 10) = 1 Then
If Worksheets("Stats").Cells(g, 10).Value = 1 Then
a = ActiveSheet.Cells(g, 9).Value
If Application.WorksheetFunction.IsNumber(ActiveSheet.Range("J" & g + 1).Value) = True Then
b = ActiveSheet.Cells(g + 1, 9).Value
c = b - a
ActiveSheet.Range("N" & g).Value = c
Else:
b = Now
c = b - a
ActiveSheet.Range("N" & g + 1).Value = c
End If
End If
Else
ActiveSheet.Range("N6").Value = 0
ActiveSheet.Range("R6").Value = 0
End If
Next
End Sub