Question

如果有人回答了很多道歉，但我一直无法在这里找到答案，或谷歌就此而言。我正在使用Excel，因此我将引用列/行。

我需要创建一个包含以下几个条件的成本分析表：

什么是类别？（完整清单：水果，蔬菜，肉类）
从中购买的商品是什么供应商？（即Sobey's，Walmart等）

所以我有：

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

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

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 Scripting Runtime (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

然后在你的main函数中，你将这样编码：

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

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

2 个答案: