excel - VBAでの配列の検索モード

Question

VBAで配列のモードを見つけようとしています。

映画のタイトルの動的なリストがあるとします。A:A と同じ長さのリスト B:B があり、これは映画の「タイプ」のリストです。

特定のタイプの、最も繰り返し使用されている上位のタイトルを見つけようとしています。

注: A:A は動的リストであり、その長さはわかりません。

---------------------------------
-Finding Nemo  - Cartoon 
-Finding Nemo  - Cartoon
-Finding Nemo  - Cartoon
-Finding Nemo  - Cartoon
-Finding Nemo  - Cartoon
-Inception     - Action
-Inception     - Action
-Inception     - Action
-Dragon Ball   - Cartoon
-Dragon Ball   - Cartoon
-Dragon Ball   - Cartoon 
---------------------------------

この表を例にとると、Finding Nemo は最も多く出回っているタイトルです。しかし、その結果を返す関数を書く必要があるでしょうか?

私はこれに似た機能を想定しています：

=movieMode(5)

5 は、返してほしい「上位」の結果の数を指定します。

ここでの問題は、A:A が動的な長さの場合にこれを行う方法がわからないことです。また、返される結果の数を制御する方法。デフォルトで「漫画」のみを検索するフィルターを設定する必要があります。

これについていくつかの光を共有してください。

アップデート

いろいろ調べた結果、この式を見つけました。

=INDEX(A2:A177,MATCH(MAX(COUNTIF(A2:A177,A2:A177)),COUNTIF(A2:A177,A2:A177),0))

これは、2 つの条件の下で、最も多く発生したタイトルを返します。

Ctrl+Shift+Enter を使用します (範囲をループしているように見えますか?)
指定した範囲内に空白はありません。

typeこの数式を改善して、が Cartoon で、A'x' が空でない場合にE:E を取るようにする必要があります。(範囲が空の場合、この式は機能しないようです。

これは、Excel 数式を使用する最初の日であり、すでにこれに遭遇しています。笑

更なるアップデート

上記のシナリオを考慮して、 =movieMode(2) を使用することを期待しています

結果は

----------------------------
-Finding Nemo    - 5 
-Dragon Ball     - 3
----------------------------

「漫画」フィルターがデフォルトで関数に設定されることを期待しています。アクションがどの時点でも表示されたり、変数になったりすることは決してありません。

ただし、使用する場合

-movieMode(1)

期待される結果は

-------------------
-Finding Nemo  - 5
-------------------

score 1 · Accepted Answer

これは、Scripting オブジェクトDictionaryを使用したソリューションであり、最終的にはあまり効率的なRange処理ではありません。ただしApplication.ScreenUpdating = False、パフォーマンスの向上を維持し、画面のちらつきSubをなくすために使用しました.....これは、Top N.

Option Explicit

Sub getTopN()
Dim ws As Worksheet
Dim rng As Range
Dim vArr As Variant, d As Object, aL As Object
Dim i As Integer, j As Integer, lastRow As Long
Dim topN As Integer

Set d = CreateObject("Scripting.Dictionary")
Set ws = Sheets(1)
Set rng = ws.Range("A2")
topN = ws.Range("B2").Value '-- for testing it's 2
'-- get last used row dynamically
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'--since data starting with row 2
lastRow = lastRow - 1
vArr = WorksheetFunction.Transpose(rng.Resize(lastRow).Value)

For i = LBound(vArr) To UBound(vArr)
    If Not d.Exists(RTrim(vArr(i))) Then
        j = 1
        d.Add RTrim(vArr(i)), j
    Else
        d.Item(RTrim(vArr(i))) = d.Item(RTrim(vArr(i))) + 1
    End If
Next i

'-- screen updating false
Application.ScreenUpdating = False

'-- output items, keys in to sheet
Set rng = ws.Range("C2")
rng.Resize(UBound(d.keys) + 1) = Application.Transpose(d.keys)
rng.Offset(0, 1).Resize(UBound(d.items) + 1) = Application.Transpose(d.items)

'-- sort this new range , top N
Set rng = rng.Resize(UBound(d.items) + 1, 2)
rng.Sort key1:=Range("D2"), order1:=xlDescending, header:=xlNo
'-- copy topN rows into a temp range
ws.Range("E2").Resize(topN, 2) = rng.Resize(topN, 2).Value
'-- clean up everything other than top N rows
rng.ClearContents
rng.Resize(topN, 2).Value = ws.Range("E2").Resize(topN, 2).Value
ws.Range("C1").Value = "Top N Movies"
ws.Range("E2").Resize(topN, 2).ClearContents
'-- release memory
Set d = Nothing

Application.ScreenUpdating = True
End Sub

出力：

ここに画像の説明を入力

score 0 · Accepted Answer

cpearson.comのこのVBA 関数を使用して、個別の値のみを含む配列を返します。それができたら、以下のロジック (既にある式に似ています) を実装して、結果を生成できます。これらはワークシートの数式ですが、VBA でも同じことができるはずです。ちなみに、cpearson の Web サイトは VBA の優れたリソースです。

title genre       distinct  cpearsonVBA     count                tieBreak         rank            #_of_results   filter_array        result
----------------------------------------------------------------------------------------------------------------------------------------------------
Finding Nemo      Cartoon   Finding Nemo    =COUNTIFS(A:A,C:C)   =ROW()^-9+D:D    =RANK(E:E,E:E)   2             =IF(F:F<=$G$2,1,0)  =IF(H:H,C:C,"")
Finding Nemo      Cartoon   Inception       =COUNTIFS(A:A,C:C)   =ROW()^-9+D:D    =RANK(E:E,E:E)                 =IF(F:F<=$G$2,1,0)  =IF(H:H,C:C,"")
Finding Nemo      Cartoon   Dragon Ball     =COUNTIFS(A:A,C:C)   =ROW()^-9+D:D    =RANK(E:E,E:E)                 =IF(F:F<=$G$2,1,0)  =IF(H:H,C:C,"")
Finding Nemo      Cartoon              
Finding Nemo      Cartoon              
Inception         Action             
Inception         Action             
Inception         Action             
Dragon Ball       Cartoon              
Dragon Ball       Cartoon              
Dragon Ball       Cartoon

excel - VBAでの配列の検索モード

2 に答える 2

Related

Reference