Я пытаюсь найти, где есть «1» и найти следующую «1» в диапазоне - PullRequest
0 голосов
/ 19 марта 2020

У меня есть небольшой проект, над которым я работаю, где у меня есть диапазон ячеек, которые имеют статус 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

enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...