0

そのため、Excelでいくつかのデータを分析しようとしていますが、最も頻繁な数値を見つけるのに問題があります。寄付の数が不明な場所があります。例えば

  • ブラントフォード$50.00
  • ブラントフォード$25.00
  • ブラントフォード$50.00
  • ウィンザー$200.00
  • ケベック$25.00
  • ケベック$100.00
  • ケベック$50.00
  • ケベック$50.00
  • ケベック$25.00
  • ケベック$50.00
  • ケベック$50.00
  • ケベック$25.00
  • ケベック$100.00
  • ケベック$40.00
  • ウィンザー$140.00
  • ウィンザー$20.00
  • ウィンザー$20.00

したがって、VBAを使用して、場所ごとにカウント、合計、平均、およびモードを見つける必要があります（VBAを介して実行する必要があり、高度なフィルター/ピボットテーブルを使用してこれを行う方法の説明を書くことはできません:(）。

そのため、現在VBAを使用しているので、場所の名前をキーとして保存し、各寄付をコレクションに格納する辞書オブジェクトがあります。私がカウントしているコレクションのカウントを使用すると、平均値を使用して、合計のコレクションを簡単にループできます。しかし、モードを取得するための最も効率的な方法はわかりません。

Application.modeを使用してデータが配列内にある場合はそれを見つけることができますが、コレクションでは機能しないようです:(。モードを見つけるためにコレクションを配列に変換することは、実際には私にはわかりませんが最も効率的な解決策ですが、私が見つけることができる他のオプションは、コレクションを並べ替えてから、それらをループしてモードを見つけることです。

それで、コレクションの統計モードを見つける良い方法を誰かが知っているかどうか疑問に思いますか？

Dim locdata As Object
Set locdata = CreateObject("scripting.dictionary")  

For counter = 2 To max
    mykey = Cells(counter, loccol).value
    If Not (locdata.exists(mykey)) Then
        locdata.Add (mykey), New Collection
    End If
    locdata(mykey).Add (Cells(counter, donamountcol).value)
Next counter
For Each k In locdata.keys
    locname = k
    Cells(counter, 1) = k
    Cells(counter, 2) = locdata(k).Count
    donationtotal = 0
    For Each donvalue In locdata(k)
        donationtotal = donationtotal + donvalue
    Next donvalue
    Cells(counter, 3) = donationtotal
    Cells(counter, 4) = donationtotal / CDbl(locdata(k).Count)
    'Cells(counter, 5) = Application.mode(locdata(k)) doesn't work :(
    counter = counter + 1
Next k

編集：理想的には、出力は次のようになります（例としてケベックを使用）ケベック：カウント：10合計：515平均：51.5モード：50

4

3 に答える 3

0

範囲内の値を動的に配列に含める方法は次のとおりです。そして、私はCountIFVBAで、名前で最も頻繁に使用されるオブジェクトを見つけるために使用します。またはを知らないので。location namesdonations次に、配列が進むべき道です。

Dim ar as Variant
Dim endRow as Long

'get last row in the range
endRow = Sheets(1).Cells(Sheets(1).Rows.Count, "A").End(xlUp).Row    
'ar = WorksheetFunction.Transpose(Shets(1).Range("A1:A12")
 'using endrow
 ar = WorksheetFunction.Transpose(Shets(1).Range("A1").resize(endRow).value)

更新：subroutine以下は、1回の反復（forループ）を使用して.を検索しModeます。

Sub FrequencyByLocDonations()
Dim ar As Variant, dc As Object
Dim rngInput As Range, mxRng As Range
Dim endRow As Long, i As Integer
Dim counts As Double, maxLoc As Double
Dim maxLocation As String
   Set dc = CreateObject("Scripting.Dictionary")

   '-- When you know the range
   '   ar = WorksheetFunction.Transpose(Shets(1).Range("A1:A12").Value

    'get last row in the range when you don't know but the starting cell
    endRow = Sheets(3).Cells(Sheets(3).Rows.Count, "C").End(xlUp).Row
    Set rngInput = Sheets(3).Range("C2").Resize(endRow - 1, 1)

    '--you may also use that set rngInput as well
    '   WorksheetFunction.Transpose(rngInput).Value

    '-- using endrow-1 to not to take an extra blank row at the end
    ar = WorksheetFunction.Transpose(Sheets(3).Range("C2").Resize(endRow - 1, 2).Value)

    For i = LBound(ar, 2) To UBound(ar, 2)
        If Not (dc.exists(ar(1, i))) Then
            counts = Application.WorksheetFunction.CountIf(rngInput, ar(1, i))
            If counts >= maxLoc Then
                maxLocation = ar(1, i)
                maxLoc = counts
            End If
            dc.Add ar(1, i), counts
        End If
    Next i

    '-- output to the Sheet
    Sheets(3).Range("C2").Offset(0, 2).Resize(UBound(dc.keys) + 1, 1) = _ 
              Application.Transpose(dc.keys)
    Sheets(3).Range("C2").Offset(0, 3).Resize(UBound(dc.items) + 1, 1) = _
              Application.Transpose(dc.items)
    Sheets(3).Range("C2").Offset(0, 4) = "Most Frequent Location :" _ 
              & maxLocation & "; " & maxLoc

    Set dc = Nothing
End Sub

出力：

ここに画像の説明を入力してください

于 2013-01-10T16:22:21.593 に答える
0

私は過去に同様の状況に遭遇しました。非常に強力なVBA関数がExcelにないように見えました。これは、MySQLの「where」ステートメントに相当します。
だから私は自分で非常に単純なものを書きました...これは多くの機能を欠いていますが、あなたが書くコードの量を最小限に抑えながら、あなたが求めていることをすることができます。
基本的な概念：関数呼び出しから配列を返すことができ、Excelの組み込み関数は、関数の場合と同じようにそのような配列を操作できます。したがって、「モードが必要なすべての数」を返す関数がある場合は、=MODE(myfunction())必要な答えが得られます。
関数を呼び出すことにしましたsubset(criteria, range1, range2)。
最も単純な形式では、基準を満たすrange1の要素に対応するrange2の要素を返します。これは広範囲にテストされていませんが、あなたがアイデアを得ることを願っています。
ちなみに、これは配列数式（shift-ctrl-enter）として複数のセルに入力できます。その場合、最初のセルなどで最初に返された要素を取得します。複数の値（範囲など）を返す必要がある関数がある場合、これは便利なトリックですが、この場合は、次の結果のみが必要です。別の関数にフィードします。

Option Explicit
' Function subset(criteria, range1, range2)
' Return an array with the elements in range2 that correspond to
' elements in range1 that match "criteria"
' where "criteria" can be a string, or a value with a < = > sign in front of it

' example: =subset("bravo", A1:A10, B1:B10)
' returns all cells from B that corresponds to cells in A with "bravo"
' =subset("<10", A1:A10, B1:B10) returns all cells in B corresponding to
' cells in A with a value < 10
' This is analogous to the "where" function in SQL, but much more primitive

Function subset(criteria As String, range1 As Range, range2 As Range)
Dim c
Dim result
Dim ii, jj As Integer
On Error GoTo etrap

If range1.Cells.Count <> range2.Cells.Count Then Exit Function
ReDim result(1 To range1.Cells.Count)
ii = 1
jj = 1
For Each c In range1.Cells
If compare(c.Value, criteria) = 0 Then
  result(ii) = range2.Cells(jj).Value
  ii = ii + 1
End If
jj = jj + 1
Next c

If ii > 1 Then
ReDim Preserve result(1 To ii - 1)
subset = result
Else
subset = Nothing
End If

Exit Function
etrap:
MsgBox "Error " & Err.Description
End Function

Private Function compare(a, b)
' type of a decides what kind of comparison we do
If TypeName(a) <> TypeName("hello") Then
' use numerical comparison
compare = Not (Evaluate(a & b))
Else
' use string comparison
compare = StrComp(a, b, vbTextCompare)
End If
End Function
于 2013-01-10T23:02:57.337 に答える
0

私は実際に辞書の辞書を作ることにしました。だから私は場所と各場所を持っていますが、各寄付額のカウントの辞書を持っています。モードを見つけるためにその方法でカウントを比較するのに十分簡単でした。

于 2013-01-16T15:39:32.000 に答える