ищет помощь в понимании различных функций кодов

Question

Я пытаюсь создать формулу для обнаружения двух вещей.1 - определить количество ячеек, установленных на высоком уровне (имеют значение 1), в каждой строке и всплывающее сообщение, когда 7 столбцов в необработанном виде были высокими.и затем переходите к следующему сырью, пока не закончите все строки2 - извлечь этот высокий вклад из другого документа (слова) на основе заголовка.

изо всех сил пытался идентифицировать ячейки и делать 7 в необработанном расчете.в основном из-за неисправностей, таких как вне диапазона.

Sub SplitByPerson()

  Dim ColDestCrnt As Long
  Dim ColDestTitle As Long
  Dim ColSrc As Long
  Dim RowSrcCrnt As Long
  Dim RowSrcSt As Long
  Dim RowSrcStartCycle As Long
  Dim RowDestCrnt As Long
  Dim sickCrnt As Long
  Dim sickTotal As Long
  Dim sickcount As Long

  Dim MyArray() As Integer
  MyArray(8) = 234 ' Causes Error 9.

  ' Assume data starts in B3
  RowSrcSt = 3
  ColSrc = 2

  ' Detection cycles starting from Row 3
  'RowDestCrnt = 3
 ' ColDestTitle = 1

  'With Worksheets("Sheet1")



    Do Until RowSrcCrnt = 20

    If RowSrcCrnt < 20 And ColSrc < 20 Then
      ' Record start of sick cycle

      RowSrcCrnt = RowSrcSt + 1

      ' Search for sick for 7 days
      Do Until RowSrcCrnt = 20 & ColSrc = 20

        RowSrcCrnt = RowSrcCrnt
        ColSrc = ColSrc + 1

        If Sheet1.Cells(RowSrcCrnt, ColSrc).Value > 0 And _
        Range("RowSrcCrnt").Formula.Value = "=SUM (" & Range(Cells("RowSrcCrnt", "ColSrc"), Cells("RowSrcCrnt", "ColSrc" + 6)).Address(False, False) & ")" > 7 Then

        'The two false after Adress is to define the vaddress as relative (A2:B3).
        'If you omit the parenthesis clause or write True instead, you can set the address
        'as absolute ($A$2:$B$3)._

        ' This shows it have been sick for 7 weeks
        MsgBox " 7 sick weeks reached for " & Range(Cells(RowSrcCrnt, 1)).Value


          Exit Do
        End If
        ' Continue search for 7 weeks abscense
      Loop

        Exit Do
      End If

   Loop
           MsgBox " Search finished "

 End With

End Sub

введите описание изображения здесь

Answer 1

Вот один из способов сделать это:

Sub consecutiveSevens()
Dim sht As Worksheet
Dim rng As Range
Dim rngRow As Range
Dim cell As Range
Dim i As Long
Dim maxCon As Long

Set sht = ThisWorkbook.Worksheets("Sheet3")
Set rng = sht.Range("A1:Z10")

For Each rngRow In rng.Rows
    i = 0
    maxCon = 0
    For Each cell In rngRow.Cells
        If cell.Value = 1 Then
            i = i + 1
            If i > maxCon Then
                maxCon = i
            End If
        Else
            If i > maxCon Then
                maxCon = i
            End If
            i = 0
        End If
    Next cell
    If maxCon > 7 Then
        rngRow.Interior.Color = RGB(0, 200, 0)
        MsgBox "More than 7 consecutive 1's were found in row: " & rngRow.row
    Else
        rngRow.Interior.Color = RGB(255, 200, 200)
    End If
Next rngRow

End Sub

Код отслеживает максимальное количество последовательных вхождений 1 в каждой строке.Если их больше 7, строка выделяется зеленым цветом и появляется сообщение.Если нет, то строка выделяется розовым цветом.

Вот пример: