将范围分配给数组

我一直在为此奋斗了一段时间,但popup的错误对话框并不是最有帮助的。 我试图从工作表中提取一个名称列表,并使用范围函数将它们分配给一个数组。 我尝试过,但我似乎无法得到它的工作,所以我试着读取单元格中的1,而不是使用Do Until Loop。 我没想到会在这里发表,所以我以前做的代码已经没有了,但是这里有一个例子:

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 

第一个返回一个空的范围,“找不到任何单元格”,第二个给了我一个空的string数组长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循环未初始化的错误,我回溯到“ResourceList”数组/范围为空。

[编辑]该function用于准备从下拉框资源列表中提取的名称数组。 这个列表可能包含多个相同名称的实例,所以它被发送到FilterArray函数来将数组sorting成只有每个名字一个实例的数组。 例如: sorting前后

在此之后,它被发送到一个模块,将每个名字注入一个字典中,相应的小时数,这个人被安排工作。