vba 中的数组有问题
Trouble with Arrays in vba
感谢大家的帮助。我已经成功填充并查看了数组的内容。现在我无法在我编写的函数中调用数组中的特定实例(字符串值)来将 sheet 中的单元格与数组中的值进行比较....
我在我的 strcomp() 函数中获取了 "subscript out of range"。我已经检查过,正确的值正在通过 vCompare 传递。
数组太挑剔了!
这是更新后的代码:
Sub searchTrucks()
Dim lastRow As Long
Dim EndRow As Long
Dim showAll As Boolean
Dim BeginRow As Long
Dim RowCnt As Long
Dim chckTech As Long
Dim chckReg As Long
Dim chckSite As Long
Dim chckUnum As Long
Dim chckType As Long
Dim chckAge As Long
Dim chckDt As Long
Dim chckCap As Long
Dim i As Integer
Dim aRan As Range
Dim bRan As Range
Dim cRan As Range
Dim rrRan As Range
Dim rmRan As Range
Dim marray() As Variant
marray = WorksheetFunction.Transpose(Worksheets("Calculations").Range("F2:K2"))
Dim vCompare As String
Dim x As Long
Dim y As Long
y = 2
x = 1
i = 1
lastRow = Application.CountA(Sheets("Trucks").Range("C:C"))
BeginRow = 6
EndRow = lastRow + 4
chckSite = 3
chckUnum = 4
chckType = 5
chckAge = 7
chckDt = 10
chckCap = 11
Debug.Print lastRow
For i = 1 To 8
If IsEmpty(Sheets("Trucks").Cells(2, i).Value) Then
showAll = True
Else
showAll = False
Exit For
End If
Next i
Debug.Print showAll
If showAll = False Then
For RowCnt = BeginRow To EndRow
If Not IsEmpty(Sheets("Trucks").Cells(2, 3).Value) And IsEmpty(Sheets("Trucks").Cells(2, 4).Value) Then
For y = 2 To 6
If Sheets("Trucks").Cells(2, 3).Value = Sheets("Calculations").Cells(y, 5).Value Then
vCompare = Sheets("Trucks").Cells(RowCnt, chckSite).Value
If IsInArray(vCompare, marray) = -1 Then
Cells(RowCnt, chckSite).EntireRow.Hidden = True
End If
End If
Next
Stop
End If
If Not IsEmpty(Sheets("Trucks").Cells(2, 4).Value) And Sheets("Trucks").Cells(RowCnt, chckSite).Value <> Sheets("Trucks").Cells(2, 4).Value Then
Cells(RowCnt, chckSite).EntireRow.Hidden = True
ElseIf Not IsEmpty(Sheets("Trucks").Cells(2, 5).Value) And Sheets("Trucks").Cells(RowCnt, chckUnum).Value <> Sheets("Trucks").Cells(2, 5).Value Then
Cells(RowCnt, chckUnum).EntireRow.Hidden = True
ElseIf Not IsEmpty(Sheets("Trucks").Cells(2, 6).Value) And Sheets("Trucks").Cells(RowCnt, chckType).Value <> Sheets("Trucks").Cells(2, 6).Value Then
Cells(RowCnt, chckType).EntireRow.Hidden = True
ElseIf Not IsEmpty(Sheets("Trucks").Cells(2, 7).Value) And Sheets("Trucks").Cells(RowCnt, chckAge).Value < Sheets("Trucks").Cells(2, 7).Value Then
Cells(RowCnt, chckAge).EntireRow.Hidden = True
ElseIf Not IsEmpty(Sheets("Trucks").Cells(2, 9).Value) And Sheets("Trucks").Cells(RowCnt, chckDt).Value < Sheets("Trucks").Cells(2, 9).Value Then
Cells(RowCnt, chckDt).EntireRow.Hidden = True
ElseIf Not IsEmpty(Sheets("Trucks").Cells(2, 10).Value) And Sheets("Trucks").Cells(RowCnt, chckCap).Value < Sheets("Trucks").Cells(2, 10).Value Then
Cells(RowCnt, chckCap).EntireRow.Hidden = True
End If
Next RowCnt
Else
Sheets("Trucks").Cells.EntireRow.Hidden = False
End If
这是我的函数代码:
Function IsInArray(stringToBeFound As String, arr As Variant) As Long
Dim i As Long
' default return value if value not found in array
IsInArray = -1
Debug.Print stringToBeFound
For i = LBound(arr) To UBound(arr)
If StrComp(stringToBeFound, arr(i), vbTextCompare) = 0 Then
IsInArray = i
Exit For
End If
Next i
End Function
要填充数组,您可以这样做
Dim aArray As Variant
aArray = WorksheetFunction.Transpose(Worksheets("Calculations").Range("F2:K2"))
对于您的所有其他阵列也类似。
您不能在数组上使用 debug.print
。相反,在 VBA 编辑器中右键单击变量名称 (aArray
) 和 select "Add watch"。您的变量将出现在 "Watches" window 中。现在,在您(正确地)在代码中填充 aArray
和 运行 之后添加一个断点。它将在断点处停止,您现在可以进入 "Watches" window 并展开 aArray
变量。您将在此处看到数组的内容。
关于 Array
函数的使用,请参阅 here - 需要逗号分隔的项目列表。它通常用于快速创建变体数组,通常用于由小列表组成的静态数据。例如,Array("Jan", "Feb", "Mar",...,"Dec")
...之类的东西。
在使用数组时,通常不需要显式调用此构造函数。对于简单的非 Variant 数据类型,类型 X 的数组定义如下:
dim an_X_array(10) as X
这将 an_X_array
定义为一个包含 10 个项目的数组,每个项目的类型为 X
将其与定义为 X
类型的简单变量进行比较
dim an_X as X
关于您的第二个问题 - 它是由您从范围(工作表数据)创建的数组构造为二维数组引起的。您可以使用二维数组并更改您的公式,或者使用下面的辅助函数从您的工作表数据创建一个一维数组。这是从任何工作表范围创建适当的一维数组的函数(只需将其复制粘贴到您的代码模块中的某处):
Public Function RngToArray(ByRef InputRange As Range) As Variant
Dim A As Variant
Dim rr As Range
Dim i As Long
ReDim A(InputRange.Cells.Count)
i = LBound(A)
For Each rr In InputRange
A(i) = rr.Value
i = i + 1
Next
ReDim Preserve A(i - 1)
RngToArray = A
End Function
对于您的示例,您只需替换一行代码:
改变
marray = WorksheetFunction.Transpose(Worksheets("Calculations").Range("F2:K2"))
至
marray = RngToArray(Worksheets("Calculations").Range("F2:K2"))
你填充数组的方式,你会得到一个二维数组,所以我修改了你的源代码来测试你的值是否在数组中:
Function IsInArray( Byval stringToBeFound As String, Byref arr As Variant) As Long
Dim i As Long 'i is the columns variable
Dim J& 'j is the rows variable
' default return value if value not found in array
IsInArray = -1
Debug.Print stringToBeFound
For i = LBound(arr,2) To UBound(arr,2) 'the ,2 is to say the 2nd dimension (same order of dimensions as if you'd use the cells function)
For j = LBound(arr,1) To UBound(arr,1)
If stringToBeFound = arr(j,i) Then 'simple test of strings
IsInArray = i 'will give the column as answer
Exit Function 'Exit For
End If
Next i
End Function
感谢大家的帮助。我已经成功填充并查看了数组的内容。现在我无法在我编写的函数中调用数组中的特定实例(字符串值)来将 sheet 中的单元格与数组中的值进行比较....
我在我的 strcomp() 函数中获取了 "subscript out of range"。我已经检查过,正确的值正在通过 vCompare 传递。
数组太挑剔了!
这是更新后的代码:
Sub searchTrucks()
Dim lastRow As Long
Dim EndRow As Long
Dim showAll As Boolean
Dim BeginRow As Long
Dim RowCnt As Long
Dim chckTech As Long
Dim chckReg As Long
Dim chckSite As Long
Dim chckUnum As Long
Dim chckType As Long
Dim chckAge As Long
Dim chckDt As Long
Dim chckCap As Long
Dim i As Integer
Dim aRan As Range
Dim bRan As Range
Dim cRan As Range
Dim rrRan As Range
Dim rmRan As Range
Dim marray() As Variant
marray = WorksheetFunction.Transpose(Worksheets("Calculations").Range("F2:K2"))
Dim vCompare As String
Dim x As Long
Dim y As Long
y = 2
x = 1
i = 1
lastRow = Application.CountA(Sheets("Trucks").Range("C:C"))
BeginRow = 6
EndRow = lastRow + 4
chckSite = 3
chckUnum = 4
chckType = 5
chckAge = 7
chckDt = 10
chckCap = 11
Debug.Print lastRow
For i = 1 To 8
If IsEmpty(Sheets("Trucks").Cells(2, i).Value) Then
showAll = True
Else
showAll = False
Exit For
End If
Next i
Debug.Print showAll
If showAll = False Then
For RowCnt = BeginRow To EndRow
If Not IsEmpty(Sheets("Trucks").Cells(2, 3).Value) And IsEmpty(Sheets("Trucks").Cells(2, 4).Value) Then
For y = 2 To 6
If Sheets("Trucks").Cells(2, 3).Value = Sheets("Calculations").Cells(y, 5).Value Then
vCompare = Sheets("Trucks").Cells(RowCnt, chckSite).Value
If IsInArray(vCompare, marray) = -1 Then
Cells(RowCnt, chckSite).EntireRow.Hidden = True
End If
End If
Next
Stop
End If
If Not IsEmpty(Sheets("Trucks").Cells(2, 4).Value) And Sheets("Trucks").Cells(RowCnt, chckSite).Value <> Sheets("Trucks").Cells(2, 4).Value Then
Cells(RowCnt, chckSite).EntireRow.Hidden = True
ElseIf Not IsEmpty(Sheets("Trucks").Cells(2, 5).Value) And Sheets("Trucks").Cells(RowCnt, chckUnum).Value <> Sheets("Trucks").Cells(2, 5).Value Then
Cells(RowCnt, chckUnum).EntireRow.Hidden = True
ElseIf Not IsEmpty(Sheets("Trucks").Cells(2, 6).Value) And Sheets("Trucks").Cells(RowCnt, chckType).Value <> Sheets("Trucks").Cells(2, 6).Value Then
Cells(RowCnt, chckType).EntireRow.Hidden = True
ElseIf Not IsEmpty(Sheets("Trucks").Cells(2, 7).Value) And Sheets("Trucks").Cells(RowCnt, chckAge).Value < Sheets("Trucks").Cells(2, 7).Value Then
Cells(RowCnt, chckAge).EntireRow.Hidden = True
ElseIf Not IsEmpty(Sheets("Trucks").Cells(2, 9).Value) And Sheets("Trucks").Cells(RowCnt, chckDt).Value < Sheets("Trucks").Cells(2, 9).Value Then
Cells(RowCnt, chckDt).EntireRow.Hidden = True
ElseIf Not IsEmpty(Sheets("Trucks").Cells(2, 10).Value) And Sheets("Trucks").Cells(RowCnt, chckCap).Value < Sheets("Trucks").Cells(2, 10).Value Then
Cells(RowCnt, chckCap).EntireRow.Hidden = True
End If
Next RowCnt
Else
Sheets("Trucks").Cells.EntireRow.Hidden = False
End If
这是我的函数代码:
Function IsInArray(stringToBeFound As String, arr As Variant) As Long
Dim i As Long
' default return value if value not found in array
IsInArray = -1
Debug.Print stringToBeFound
For i = LBound(arr) To UBound(arr)
If StrComp(stringToBeFound, arr(i), vbTextCompare) = 0 Then
IsInArray = i
Exit For
End If
Next i
End Function
要填充数组,您可以这样做
Dim aArray As Variant
aArray = WorksheetFunction.Transpose(Worksheets("Calculations").Range("F2:K2"))
对于您的所有其他阵列也类似。
您不能在数组上使用 debug.print
。相反,在 VBA 编辑器中右键单击变量名称 (aArray
) 和 select "Add watch"。您的变量将出现在 "Watches" window 中。现在,在您(正确地)在代码中填充 aArray
和 运行 之后添加一个断点。它将在断点处停止,您现在可以进入 "Watches" window 并展开 aArray
变量。您将在此处看到数组的内容。
关于 Array
函数的使用,请参阅 here - 需要逗号分隔的项目列表。它通常用于快速创建变体数组,通常用于由小列表组成的静态数据。例如,Array("Jan", "Feb", "Mar",...,"Dec")
...之类的东西。
在使用数组时,通常不需要显式调用此构造函数。对于简单的非 Variant 数据类型,类型 X 的数组定义如下:
dim an_X_array(10) as X
这将 an_X_array
定义为一个包含 10 个项目的数组,每个项目的类型为 X
将其与定义为 X
dim an_X as X
关于您的第二个问题 - 它是由您从范围(工作表数据)创建的数组构造为二维数组引起的。您可以使用二维数组并更改您的公式,或者使用下面的辅助函数从您的工作表数据创建一个一维数组。这是从任何工作表范围创建适当的一维数组的函数(只需将其复制粘贴到您的代码模块中的某处):
Public Function RngToArray(ByRef InputRange As Range) As Variant
Dim A As Variant
Dim rr As Range
Dim i As Long
ReDim A(InputRange.Cells.Count)
i = LBound(A)
For Each rr In InputRange
A(i) = rr.Value
i = i + 1
Next
ReDim Preserve A(i - 1)
RngToArray = A
End Function
对于您的示例,您只需替换一行代码:
改变
marray = WorksheetFunction.Transpose(Worksheets("Calculations").Range("F2:K2"))
至
marray = RngToArray(Worksheets("Calculations").Range("F2:K2"))
你填充数组的方式,你会得到一个二维数组,所以我修改了你的源代码来测试你的值是否在数组中:
Function IsInArray( Byval stringToBeFound As String, Byref arr As Variant) As Long
Dim i As Long 'i is the columns variable
Dim J& 'j is the rows variable
' default return value if value not found in array
IsInArray = -1
Debug.Print stringToBeFound
For i = LBound(arr,2) To UBound(arr,2) 'the ,2 is to say the 2nd dimension (same order of dimensions as if you'd use the cells function)
For j = LBound(arr,1) To UBound(arr,1)
If stringToBeFound = arr(j,i) Then 'simple test of strings
IsInArray = i 'will give the column as answer
Exit Function 'Exit For
End If
Next i
End Function