填充动态数组与未知的字符串

Question

很多道歉，如果这已被回答，但我一直无法找到答案在这里，或谷歌的事。我使用Excel，所以我将引用列/行。

我需要建立一个成本分析表一对夫妇像条件：

1. 什么类别？ （全部列表：水果，蔬菜，肉类）
2. 什么供应商是该项目购买？ （即索贝的，沃尔玛等）

所以，我有：

Dim catFruits() as string, catVegies() as string, catMeats() as string 

到每个类别的声明阵列。我把它放在每行的“Category”列下，并检查类别以选择正确的数组。我希望接下来要做的是沿着“供应商”一行一行地将单元格的内容添加到选定的数组中，但如果供应商已经在数组中，则不会。我一直无法找到办法做到这一点。我到目前为止：

For x = 1 To lastRow 
    If Sheet1.Cells(x, catCol).Text = "Fruits" Then 
     catFruits() = Array(Sheet1.Cells(x, supCol).Text) 
     '|----------what I want to do----------| 
     catFruits() = Array(catFruits(), Sheet1.Cells(x,SupCol).Text) 
     'so it's like "x = x + 1" 
     '|-----but in a way that will work-----| 
     '|----------and without dupes----------| 
    ElseIf Sheet1.Cells(x, catCol).Text = "Vegetables" Then 
     catVegies() = Array(Sheet1.Cells(x, supCol).Text) 
    ElseIf Sheet1.Cells(x, catCol).Text = "Meats" Then 
     catMeats() = Array(Sheet1.Cells(x, supCol).Text) 
    End If 
Next x 

我可以找出自己的重复部分，只是另一个循环，如果可以解决这个问题。

请放心，我正在使用的所有变量已被正确声明（除了数组，我不熟悉使用它们），并使用Option Explicit。

如果您需要任何其他信息，只是问，我会尽我所能帮助。

Answer 1

除非有一个理由不使用字典，你可以使用一个Dictionary对象做到这一点。使用起来更容易，内置这些功能，并且整体上更清洁一点。

有了这个，你最终应该得到一个包含每个类别的唯一项目列表的对象。

编辑：我做的关键是项目和值是该项目的出现次数。

再次编辑：根据蒂姆威廉姆斯的建议，我做了这个字典词典。这意味着你只需要管理一次唯一性逻辑。

'AllCategories dictionary will be used to hold the text string unique to a cetegory 
'(eg. "Fruits") as the key and the value will be a dictionary used to hold all the 
'unique values and their count within that category 
Dim AllCategories As Dictionary 
Set AllCategories = New Dictionary 
'category dictionaries 
Dim catFruits As Dictionary, catVegies As Dictionary, catMeats As Dictionary 
Set catFruits = New Dictionary 'if the Microsoft Scripting Runtime Reference is checked 
Set catVegies = CreateObject("Scripting.Dictionary") 'if the MSR reference is NOT checked 
Set catMeats = New Dictionary 
'link all the category dictionaries to the AllCategories dictionary 
AllCategories.Add "Fruits", catFruits 
AllCategories.Add "Vegetables", catVegies 
AllCategories.Add "Meats", catMeats 
'add more categories to the AllCategories dictionary here as needed 

Dim categoryText As String, supColValue As String 
For X = 1 To lastRow 
    categoryText = Sheet1.Cells(X, catCol).text 
    If AllCategories.Exists(categoryText) Then 
     AllCategories (categoryText) 
     supColValue = Sheet1.Cells(X, supCol).text 
     If Not AllCategories(categoryText).Exists(supColValue) Then 
      catFruits.Add supColValue, 1 'establish first entry of this supColValue and set count to 1 
     Else 
      catFruits(supColValue) = catFruits(supColValue) + 1 'increment the count of this supColValue by one 
     End If 
    Else 
     'the value in Sheet1.Cells(X, catCol).text did not correspond to an established category 
    End If 
Next X 

您需要确保您参考Microsoft脚本运行时(Tools>References>Microsoft Scripting Runtime> check the box> OK)。您可以按照martin在评论中描述的方式使用字典之类的引用对象。这有好处。我喜欢添加引用，所以您可以在对象上获得Intellisense文本。这样你就不需要知道所有的方法。

Answer 2

您可以使用ReDim Preserve为新元素腾出空间。然而，有没有内置函数来验证，如果一个项目已经在阵中，你将不得不自己写一个，比如像这样：

Function ItemPresent(myArray() As string, item As string) As Boolean 

Dim v As Variant 
For Each v In myArray 
    If v = item Then 
     ItemPresent = True 
     Exit Function 
    End If 
Next 
ItemPresent = False 

End Function 

然后在你的主要功能，您将如下代码这样的：

Option Base 0 'this is very important, it tells VBA the arrays are 0 indexed 

... 

Dim nCatFruits As Integer, nCatVegies As Integer, nCatMeats As Integer 
nCatFruits = 0 
nCatVegies = 0 
nCatMeats = 0 

... 

ReDim Preserve catFruits(0 To nCatFruits) 
nCatFruits = nCatFruits + 1 
catFruits(nCatFruits - 1) = s 's contains the text you want to add to array