Question

当第4位（最高级）到达5位偶数列时，我想标记或突出显示五位偶数位数（0 2 4 6 8）中的数字。

示例数据：

8
2
6
0 (executed)
6
2
4 (executed)
2
0 (executed)
8 (executed)
6 (executed)
6
4 (executed)
2 (executed)
2
6
0 (executed)
2
6
6
2
4 (executed)
0 (executed)
6 (executed)
0
6
0
6
6
0
6
8 (executed)
0
6
6
2 (executed)
4 (executed)
0 (executed)
8 (executed)

执行的数字必须用粗体或颜色突出显示。

Answer 1

我认为此代码可以指导您找到解决方案：

Public Sub HighlightCols()
    ' Declare your variables
    Dim ColumnNo As Long
    Dim RowNo As Long
    Dim digit As Integer

    Dim isHighlighted As Boolean
    Dim uniqueDigits As String
    Dim lastUniqueDigits As String

    ColumnNo = 1

    Do
        RowNo = 1
        uniqueDigits = ""
        lastUniqueDigits = ""

        ' A simple way to find the last row by its value that is empty (or "")
        If (Trim(ActiveSheet.Cells(1, ColumnNo).Value & " ") = "") Then Exit Do

        Do
            ' A simple way to find the last row by its value that is empty (or "")
            If (Trim(ActiveSheet.Cells(RowNo, ColumnNo).Value & " ") = "") Then Exit Do

            ' You have your digit value of your row
            digit = Val(ActiveSheet.Cells(RowNo, ColumnNo).Value)

            ' As default highlight is false
            isHighlighted = False

            If Not (uniqueDigits Like "*" & CStr(digit) & "*") Then
                uniqueDigits = uniqueDigits & CStr(digit)
                If (Len(uniqueDigits) >= 4) Then
                    isHighlighted = True
                    lastUniqueDigits = uniqueDigits2Top(RowNo, ColumnNo)
                    uniqueDigits = ""

                ElseIf Not (Right(lastUniqueDigits, 3) Like "*" & CStr(digit) & "*") And (lastUniqueDigits <> "") Then
                    lastUniqueDigits = uniqueDigits2Top(RowNo, ColumnNo)
                    isHighlighted = True

                End If
            End If

            ' Assign your clue for highlighting
            If (isHighlighted) Then

                ' I set highlighting by a yellow background
                ActiveSheet.Cells(RowNo, ColumnNo).Interior.Color = vbYellow

            Else
                ActiveSheet.Cells(RowNo, ColumnNo).Interior.Color = vbWhite

            End If

            ' Preparing for next row
            RowNo = RowNo + 1

        Loop

        ' Preparing for next column
        ColumnNo = ColumnNo + 1
        RowNo = 1
    Loop    ' Use loop statements instead of goto
End Sub

Private Function uniqueDigits2Top(ByVal curRow As Long, ByVal curCol As Long) As String
    Dim uniqueDigits As String
    uniqueDigits = ""
    uniqueDigits2Top = uniqueDigits
    Do
       If Not (uniqueDigits Like "*" & Trim(ActiveSheet.Cells(curRow, curCol).Value & " ") & "*") Then
           uniqueDigits = uniqueDigits & Trim(Val(ActiveSheet.Cells(curRow, curCol).Value & ""))
           If (Len(uniqueDigits) = 3) Then
               uniqueDigits2Top = uniqueDigits
               Exit Function
           End If
       End If

       curRow = curRow - 1
       If curRow < 1 Then Exit Function

    Loop
End Function

如何按列方式标记已执行的事件

1 个答案: