布尔数组和变体类型 vba
Posted
技术标签:
【中文标题】布尔数组和变体类型 vba【英文标题】：boolean array and variant type vba 【发布时间】：2015-09-01 16:42:07 【问题描述】：将 boolean() 数组传递给变体类型（变体类型驻留在类模块中）时，我得到了意想不到的结果。我希望得到一个 true 的值，但收到的是 false。我在下面提供了代码 sn-ps 以供评论
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
【问题讨论】：
为什么不将它作为布尔值传递？ 实际问题是什么？您没有提供太多背景信息。flag_array = emp.hasErrors 这不能在子/函数之外。
【参考方案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
【讨论】：
感谢 John 等人提供 cmets。但是，我现在使用上面提供的 sn-ps 得到类型不匹配错误 emp.SetFlag idx, False。我在员工类中有一个属性作为私有错误作为 Variant 这可能会引发错误，是否应该将其声明为布尔数组类型？基本上我的源代码（为了清楚起见，我省略了大部分） 1. 填充 vba bean（带有值的 vba 对象） 2. 验证员工对象。 3. 最后根据每个员工经过验证的标准打印工作表，即。没有错误。 怎么样？我的示例代码显示可以将布尔数组存储在类的私有变量中，并且可以提供访问方法来读取和写入该数组的元素。你到底想用这个私有数组做什么？您提供的代码 sn-p 并不完整。一方面 - 在 sn-p 中，您永远不会初始化errors，并且您的片段似乎是从未知的子或函数中撕下的。
我想我看到了问题所在。如果你没有使用setErrors 给errors 一个值，那么SetFlag 将给出一个类型不匹配——因为它把一个空变量当作一个数组来对待。 SetFlag 不创建 数组——它允许您更改现有数组的值。可以更改代码，以便在需要时创建（或扩展）数组——尽管您可能需要私有集合而不是私有数组
嗨，我添加了整个 validateEmployee 子程序，希望能帮助您更清楚地了解我想要完成的工作。基本上，我将一个员工对象存储在一个集合中。我遍历员工对象的集合，对每个员工对象中包含的所有字段运行验证。如果所有字段都有效，我希望根据 emp 对象中包含的数据创建一个新的员工工作表 - 仅此而已。以上是关于布尔数组和变体类型 vba的主要内容，如果未能解决你的问题，请参考以下文章
VBA：只有在公共对象模块中定义的用户定义类型才能被强制转换为变体或从变体强制转换或传递给后期绑定函数