我一直在努力解决这个问题,但弹出的错误对话框并不是最有帮助的。我正在尝试从工作表中提取名称列表,并使用范围函数将它们分配给数组。我尝试过并试过,但我似乎无法让它工作,所以我尝试使用Do Until循环逐个读取单元格。我没想到会在这里发布这个,所以我以前做过的代码已经不见了,但是这里有一个例子:
Dim RangeList As Variant
RangeList = ThisWorkbook.Worksheets("Plan").Range("H1:H132").Value2
我将其切换到下一个方法,希望它能带来更直接的方法:
ReDim ResourceList(ResourceLength - 1)
I = 1
Do Until ThisWorkbook.Worksheets("Plan").Cells(I, 8).Value = ""
ResourceList(I) = ThisWorkbook.Worksheets("Plan").Cells(I, 8).Value
Workbooks("NEW PROJECT PLAN").Worksheets("Console").Cells(I, 2).Value = Resource
I = I + 1
Loop
第一个返回一个空字段,“找不到任何单元格”,第二个返回给我一个空字符串数组169个项目长。我觉得我正在撞击这个墙上的砖墙,任何帮助都会受到赞赏。 以下是我正在尝试解决的全部代码:
'Collects the List of Resources
Dim ResourceLength As Long, I As Integer
Dim ResourceList() As String
ResourceLength = ThisWorkbook.FinalRow(8, "Plan")
MsgBox ("Final Row is: " & ResourceLength) 'The Last row used in column 8
ReDim ResourceList(ResourceLength - 1)
I = 1
Do Until ThisWorkbook.Worksheets("Plan").Cells(I, 8).Value = ""
ResourceList(I - 1) = ThisWorkbook.Worksheets("Plan").Cells(I, 8).Value
Workbooks("NEW PROJECT PLAN").Worksheets("Console").Cells(I, 2).Value = Resource
I = I + 1
Loop
ResourceList = ThisWorkbook.FilterArray(ResourceList)
Dim myCount As Integer
Dim Source As Variant
For Each Source In ResourceList
Worksheets("Console").Cells(myCount, 1).Value = Source
myCount = myCount + 1
Next Source
这是FilterArray函数:
Public Function FilterArray(UnsortedArray As Variant) As Variant
Dim Intermediate() As Variant
Dim UItem As Variant
' Runs through each item and compares it to the list of items found, if it finds repeats, it throws them out.
For Each UItem In UnsortedArray
If Not ArrayItemExist(Intermediate, UItem) Then
' The Item does not Exist
ReDim Intermediate(UBound(Intermediate) + 1)
Intermediate(UBound(Intermediate)) = UItem
End If
Next UItem
' Returns the Sorted Array.
FilterArray = Intermediate
End Function
Private Function ArrayItemExist(TargetArray() As Variant, TargetItem As Variant) As Boolean
'Searches an Array for TargetItem and returns a boolean stating whether it exists within the Array or not.
Dim ItemFound As Boolean
Dim SItem As Variant
ItemFound = False
For Each SItem In TargetArray
If TargetItem = SItem Then
ItemFound = True
Exit For
End If
Next SItem
ArrayItemExist = ItemFound
End Function
Public Function FinalRow(Column As Integer, Sheet As String) As Long
' Finds the last Row used in the spreadsheet.
FinalRow = Worksheets(Sheet).Cells(Rows.Count, Column).End(xlUp).Row
End Function
当我尝试运行该软件时,我收到一个错误,即For Loop未初始化,我追溯到'ResourceList'数组/范围为空。
[编辑] 此函数用于准备从下拉框资源列表中提取的名称数组。此列表可能包含多个同名实例,因此将其发送到FilterArray函数以将数组排序为只包含每个名称的一个实例的数组。例: Before and after sorting
在此之后,它被发送到一个模块,该模块将每个名称注入一个字典中,该字典具有该人员计划工作的相应小时数。