布尔数组和变体类型vba

Question

将boolean（）数组传递给变量类型（变体类型驻留在类模块中）时，我得到了意想不到的结果。我希望得到一个真值但却收到假的。我在下面提供了代码片段以供评论

Private Sub validateEmployee(ByVal employeeCollection As collection)


Dim ws As Worksheet
Dim emp As Employee
Dim empID As Integer
Dim cell As String
Dim errors() As Boolean
Dim idx As Long
Dim arr() As String
Dim cell_address() As String

Dim flag_array() As Boolean
Dim m As Integer
Dim valid_flag As Boolean
Dim counter As Integer
Dim output As String

Sheet1.unProtectWS "x"

Set ws = Worksheets("x")

ws.Select
With Selection

    For Each emp In employeeCollection

        empID = empID + 1

        'Debug.Print ("validation runs... for emp: " & empID)

        'validate all fields within Employee Object
        'if invalid field exists colour it red
        'set global error flag to ensure no worksheet gets printed

        '######################################################
        'START Header  Section
        '######################################################

        'year 
        cell = emp.getJournalYearCell
        idx = 1
        ReDim errors(idx)

        If emp.getJournalYear = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If

        'region 
        cell = emp.getRegionCell
        idx = idx + 1
        ReDim errors(idx)

        If emp.getRegion = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If

        'district 
        cell = emp.getDistrictCell
        idx = idx + 1
        ReDim errors(idx)

        If emp.getDistrict = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If

        'journal number 
        cell = emp.getJournalNumberCell
        idx = idx + 1
        ReDim errors(idx)

        If emp.getJournalNumber = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If

        '######################################################
        ' END Header  Section
        '######################################################


        '#########################
        'START Employee Line Items
        '#########################

        'employee name
        cell = emp.getNameCell
        idx = idx + 1
        ReDim errors(idx)

        If emp.getName = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If

        'classification code
        cell = emp.getClassCodeCell
        idx = idx + 1
        ReDim errors(idx)

        If emp.getClassCode = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If

        'hourly rate
        cell = emp.getHourlyRateCell
        idx = idx + 1
        ReDim errors(idx)

        If emp.getHourlyRate = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If

        'certification number
        cell = emp.getCertNumberCell
        idx = idx + 1
        ReDim errors(idx)

        If emp.getCertNumber = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If

        'employee day
        cell = emp.getEDayCell
        idx = idx + 1
        ReDim errors(idx)

        If emp.getDay = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If

        'employee month
        cell = emp.getEMonthCell
        idx = idx + 1
        ReDim errors(idx)

        If emp.getMonth = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If

        'employee year
        cell = emp.getEYearCell
        idx = idx + 1
        ReDim errors(idx)

        If emp.getEYear = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If

        'cheque number
        cell = emp.getChequeNoCell
        idx = idx + 1
        ReDim errors(idx)

        If emp.getChequeNo = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If

        'mailing address field 1
        cell = emp.getAddress1Cell
        idx = idx + 1
        ReDim errors(idx)

        If emp.getAddress1 = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If

        'mailing address field 2
        cell = emp.getAddress2Cell
        idx = idx + 1
        ReDim errors(idx)

        If emp.getAddress2 = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If

        '****************************
        'START SIN 
        '****************************


        'sin or treaty dropdown
        cell = emp.getSinOrTreatyAddress
        idx = idx + 1
        ReDim errors(idx)





        'fetch ssn array
        arr = emp.getSSN

        'fetch ssn cell address range
        cell_address = emp.getSSN_cells

        If emp.getSinOrTreaty = "" Or emp.getSinOrTreaty = "sin" Then

            Dim str As String
            Dim i As Integer
            Dim c As String

            Dim flag As Boolean

            'toggle sinOrTreaty dropdown menu
            If emp.getSinOrTreaty = "" Then
                Range(cell).Interior.Color = RGB(255, 0, 0)
            Else
                Range(cell).Interior.Color = RGB(255, 255, 255)
            End If


            For i = LBound(arr) To UBound(arr)
                str = str & arr(i)
            Next i
            'Debug.Print (str)

            'return overall result ie. valid or invalid SIN
            'if sin is not valid, return false in this circumstance
            flag = Utility.Verify_SIN(str)
            'Debug.Print (flag)



            If flag = False Then
                'SIN invalid
                errors(idx) = True
                'emp.SetFlag idx, True

                'set range
                Range(cell_address(1), cell_address(9)).Interior.Color =   RGB(255, 0, 0)

            Else
                errors(idx) = False
                'emp.SetFlag idx, False
                Range(cell_address(1), cell_address(9)).Interior.Color = RGB(255, 255, 255)
            End If

        Else
            'treaty number is not validated
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell_address(1), cell_address(9)).Interior.Color = RGB(255, 255, 255)
        End If

        '****************************
        'END SIN
        '****************************


        '#########################
        'END Employee Line Items
        '#########################


        '#########################
        'START FOOTER SECTION
        '#########################

        'prepared by field
        cell = emp.getPreparedByCell
        idx = idx + 1
        ReDim errors(idx)

        If emp.getPreparedBy = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If

        'print name field
        cell = emp.getPrintedNameCell
        idx = idx + 1
        ReDim errors(idx)

        If emp.getPrintedName = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If

        '#########################
        'END FOOTER SECTION
        '#########################

        '##########################
        'Validate Commissary Amount
        '##########################

        emp.setErrors = errors



        'check errors, true is not found but why
        Dim y As Long
        y = 0



        For y = 0 To 17
            Debug.Print (emp.hasErrors()(y))

            If emp.hasErrors()(y) = True Then
                valid_flag = False
                'exit on first error thrown
                Exit For
            Else
                'set marker
                valid_flag = True
            End If
        Next y


       flag_array = emp.hasErrors


    Next emp




End With

'###################
'Create worksheet
'###################

'idea; create only valid worksheets ie. only send valid worksheets for printing

For Each emp In employeeCollection

    flag_array = emp.hasErrors

    For m = LBound(flag_array) To UBound(flag_array)

        If (flag_array(m) = True) Then
            'exit on first error thrown
            Exit For
        Else
            'set marker
            valid_flag = True
            counter = counter + 1
        End If

    Next m

Next emp


'worksheet free from validation errors
If (valid_flag = True And empID = 15) Then
    createWS employeeCollection
Else
    output = "worksheet contains errors, please correct fields in red."
    MsgBox (output)
End If




Sheet1.protectWS "x"

End Sub

Answer 1

编辑时：在SetFlag的代码中，我现在可以根据需要创建或扩展数组。

问题是Get返回私有数组的副本 - 因此使用该类的代码会更改私有数组的副本而不是私有数组本身。解决方法是提供访问阵列的方法。例如，在你的类定义中添加这个（我不知道类的名称，所以我把它作为Employee）：

Public Sub SetFlag(i As Long, b As Boolean)
    If Not IsArray(errors) Then
        ReDim errors(0 To i) As Boolean
    ElseIf UBound(errors) < i Then
        ReDim Preserve errors(LBound(errors) To i) As Boolean
    End If
    errors(i) = b
End Sub   

Public Function GetFlag(i As Long) As Boolean
    GetFlag = errors(i)
End Function

测试子：

Sub test()
    Dim b(1 To 4) As Boolean
    Dim e As New Employee
    b(1) = False
    b(2) = True
    b(3) = True
    b(4) = False

    e.setErrors = b
    Debug.Print e.hasErrors()(3) 'prints True
    e.hasErrors()(3) = False
    Debug.Print e.hasErrors()(3) '*Still* prints True

    'but:
    e.SetFlag 3, False
    Debug.Print e.hasErrors()(3) 'now prints False
    'or just:
    Debug.Print e.GetFlag(3) 'Prints False   
End Sub