arrays - 循环遍历数组并写入错误消息

Question

我有一个表格A:G，里面是特定的必需列（A, C, D, F, G），我在其中突出显示单元格并G编写消息。列F是一个日期，我也在检查它是 < 今天。最后，我遇到了 1004 错误，因此无法进入 For 语句。

我的最终目标是在列中写入多个错误消息G，但我还没有。

任何帮助是极大的赞赏？

Option Base 1

Sub ValidateArrayColumns()

Dim errormsg() As Variant
Dim Drng As Long
Dim Row As Single
Dim Column As Single
Dim tmpDate As Variant
Dim IsError As Boolean
Dim arrReq(5) As Variant
Dim i As Single

arrReq(1) = Worksheets("Sheet2").Cells(Row, 1)
arrReq(2) = Worksheets("Sheet2").Cells(Row, 3)
arrReq(3) = Worksheets("Sheet2").Cells(Row, 4)
arrReq(4) = Worksheets("Sheet2").Cells(Row, 6)
arrReq(5) = Worksheets("Sheet2").Cells(Row, 7)

    Drng = Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row

    i = 1

    For Row = 2 To Drng
        For Column = 1 To 7
            If Column = arrReq(i) Then
                For i = 1 To arrReq(5)
                    If Cells(Row, arrReq(i)) = "" Then       'Required fields
                        Cells(Row, arrReq(i)).Interior.ColorIndex = 6
                        IsError = True
                    End If
                Next i
            End If
        Next Column

            'Checks Date
            tmpDate = Cells(Row, 4).Value
            If tmpDate = "" Then
                Cells(Row, 4).Interior.ColorIndex = 6
                IsError = True
            ElseIf tmpDate < Date Then
                Cells(Row, 4).Interior.ColorIndex = 4
                IsError = True
            End If

            'Writes error message
            If IsError = True Then
                Cells(Row, 8).Value = "Highlighted fields contain errors"
            End If

            IsError = False
    Next Row

End Sub

标签： arraysexcelvbafor-loop

Answer 1

阅读代码的注释并根据您的需要进行调整

Option Explicit

Option Base 1

Private Sub ValidateRange()

    Dim evalSheet As Worksheet
    Dim evalRange As Range
    Dim evalRow As Range
    Dim evalCell As Range

    Dim evalSheetName As String
    Dim evalColumns As String

    Dim firstRow As Long
    Dim lastRowColumn As String
    Dim lastRow As Long
    Dim relativeCol As Long
    Dim counter As Long
    Dim columnCommments As Long

    Dim errorType As Long

    Dim errorCounter As Long
    Dim errorDescrip As String
    Dim errorConcat As String

    Dim validationRule(5) As Variant

    ' Adjust the parameters to fit your needs
    evalSheetName = "Sheet2"
    evalColumns = "A:G"
    lastRowColumn = "A"                          ' Column where it's going to be searched for the last non empty row
    firstRow = 2                                 ' Skip headers

    columnCommments = 8


    ' Define the rules like column number, validation type, error description

    validationRule(1) = Array(1, "Non empty")
    validationRule(2) = Array(3, "Non empty")
    validationRule(3) = Array(4, "Non empty")
    validationRule(4) = Array(6, "Non empty")
    validationRule(5) = Array(7, "Greater than today")

    ' Set a reference to the sheet where the validation takes place
    Set evalSheet = ThisWorkbook.Worksheets(evalSheetName)

    ' Find the last row with a value in a specific column
    lastRow = evalSheet.Cells(evalSheet.Rows.Count, lastRowColumn).End(xlUp).Row

    ' Define the range to be validated
    Set evalRange = Intersect(evalSheet.Range(evalColumns), evalSheet.Rows(firstRow & ":" & lastRow))

    ' Search per row
    For Each evalRow In evalRange.Rows

        ' Reset error counter
        errorCounter = 0

        ' Reset error comments
        evalSheet.Cells(evalRow.Row, columnCommments).Value = vbNullString

        ' Loop through all cells and check if they are required and empty
        For Each evalCell In evalRow.Cells

            ' Reset error description
            errorDescrip = vbNullString


            ' Cell column is relative to the column where the range begins
            relativeCol = (evalCell.Column - evalRange.Column + 1)

            ' Get the validation result per cell
            errorType = IsCellValidAndReturnErrorType(evalCell, relativeCol, validationRule)

            Select Case errorType
            Case 0
                ' Reset format
                evalCell.Interior.ColorIndex = 0
            Case 1
                errorDescrip = errorDescrip & " " & "Cell cannot be empty"
                evalCell.Interior.ColorIndex = 6
            Case 2
                errorDescrip = errorDescrip & " " & "Cell should be a date"
                evalCell.Interior.ColorIndex = 4
            Case 3
                errorDescrip = errorDescrip & " " & "Cell should be greater than today"
                    evalCell.Interior.ColorIndex = 3
            Case Else

            End Select


            If errorType <> 0 Then

                If errorCounter >= 1 Then
                    errorConcat = " | "
                Else
                    errorConcat = vbNullString
                End If

                evalSheet.Cells(evalRow.Row, columnCommments).Value = evalSheet.Cells(evalRow.Row, columnCommments).Value & errorConcat & evalCell.Address & " has error: " & errorDescrip
                errorCounter = errorCounter + 1
            End If

        Next evalCell

    Next evalRow

End Sub

Private Function IsCellValidAndReturnErrorType(ByVal evalCell As Range, ByVal cellColumn As Long, ByVal validationRule As Variant) As Long

    Dim errorType As Long
    Dim counter As Long
    Dim errorDescrip As String

    For counter = 1 To UBound(validationRule, 1)

        ' Check if cell column has validations
        If cellColumn = validationRule(counter)(1) Then

            ' Check if meets validation rule
            Select Case validationRule(counter)(2)
            Case "Non empty"
                If evalCell.Value = vbNullString Then
                    errorType = 1
                    Exit For
                End If
            Case "Greater than today"
                If IsDate(evalCell.Value) = False Then
                    errorType = 2
                    Exit For
                ElseIf evalCell.Value < Date Then
                    errorType = 3
                    Exit For
                End If
            Case Else
                errorType = 0
            End Select
        End If

    Next counter

    IsCellValidAndReturnErrorType = errorType

End Function

一些建议：

1. 始终在模块/类的顶部使用 Option 显式（您将避免使用未声明的变量出错）
2. 尝试将变量命名为有意义且可读的名称