1

如果已经回答了这个问题，我们深表歉意，但我无法在这里找到答案，也无法在谷歌上找到答案。我正在使用 Excel，所以我将引用列/行。

我需要创建一个具有几个条件的成本分析表，例如：

  1. 什么是类别？（完整列表：水果、蔬菜、肉类）
  2. 商品是从哪个供应商处购买的？（即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。

如果您需要任何其他信息，请尽管询问，我会尽我所能提供帮助。

4

2 回答 2

6

除非有理由不使用字典，否则您可以使用Dictionary对象来执行此操作。它更易于使用，内置了这些功能，并且总体上更简洁一些。

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

编辑：我将键设为项目，将值设为该项目的出现次数。

再次编辑：根据 Tim Williams 的建议，我把它做成了一本字典。这意味着您只需管理唯一性逻辑一次。

'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 文本。这样你就不需要记住所有的方法。

于 2012-08-31T17:58:04.573 回答
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
于 2012-08-31T17:48:54.563 回答