1

これが答えられた場合は多くの謝罪がありますが、私はここで答えを見つけることができませんでした、またはそのことについてはグーグル。私はExcelを使用しているので、列/行を参照します。

次のようないくつかの条件でコスト分析テーブルを作成する必要があります。

  1. カテゴリとは何ですか？（全リスト：果物、野菜、肉）
  2. アイテムはどのサプライヤーから購入しましたか？（つまり、Sobey's、Walmartなど）

ので、私は持っています：

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

各カテゴリの配列を宣言します。「Category」列を各行で下に移動し、カテゴリをチェックして正しい配列を選択します。次に実行したいのは、「Supplier」列を1行ずつ下に移動し、セルの内容を選択した配列に追加することですが、Supplierがすでに配列に含まれている場合は追加しません。私はこれを行う方法を見つけることができませんでした。私がこれまでに持っているもの：

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

私は自分で重複部分を理解することができます、ちょうど別のループとそれを解決するかどうか。

私が使用しているすべての変数は適切に宣言されており（おそらく配列を除いて、それらの操作に慣れていません）、OptionExplicitを使用していますのでご安心ください。

他に情報が必要な場合は、質問してください。できる限りサポートさせていただきます。

4

2 に答える 2

6

辞書を使用しない理由がない限り、Dictionaryオブジェクトを使用してこれを行うことができます。作業が簡単で、これらの機能が組み込まれており、全体的に少しすっきりしています。

これにより、各カテゴリのアイテムの一意のリストを含むオブジェクトが作成されます。

編集：キーをアイテムにし、値をそのアイテムの出現回数にしました。

もう一度編集： Tim Williamsの提案に従って、これを辞書の辞書にしました。つまり、一意性ロジックを管理する必要があるのは1回だけです。

'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

MicrosoftScriptingRuntimeへの参照があることを確認する必要があります(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

次に、メイン関数で次のようにコーディングします。

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 に答える