Question

我正在尝试创建一个公式来检测两件事。 1-检测每行中设置为高（值1）的单元格的数量，并在原始数据中的7列为高时弹出msg。然后转到下一个原始文件，直到所有行完成。 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

enter image description here

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，则该行以绿色突出显示，并弹出一条消息。如果不是，则该行以粉色突出显示。

这里是一个示例：

在理解不同代码功能方面寻求帮助

1 个答案: