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 
---------------------------------

以这张表为例，海底总动员是出现次数最多的标题。但是现在我要编写一个函数来返回该结果吗？

我假设一个类似的功能：

=movieMode(5)

其中 5 指定了我想要返回的“顶级”结果的数量。

这里的问题是当 A:A 处于动态长度时我不知道该怎么做。以及如何控制要返回多少个结果。我应该设置一个过滤器，默认情况下只搜索“卡通”。

请分享一些关于这一点的信息。

更新

经过一番研究，我找到了这个公式。

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

这将在 2 个条件下返回出现次数最多的标题。

1. 我使用 Ctrl+Shift+Enter （这似乎是循环遍历范围？）
2. 我指定的范围内没有空格。

我需要改进这个公式，使其采用 E:E，其中type是卡通，并且当 A'x' 不为空时。（当范围为空时，此公式似乎不起作用。

这是我使用 excel 公式的第一天，我已经遇到过这个问题。哈哈

进一步更新

考虑到我上面给出的场景，我希望使用 =movieMode(2)

结果应该是

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

我希望默认情况下将“卡通”过滤器设置为函数。我从不希望动作出现在任何时候，也不希望它成为变量。

但是，如果我使用

-movieMode(1)

预期结果是

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

Answer 1

这是一个使用 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

输出：

Answer 2

使用cpearson.com中的此 VBA 函数返回一个仅包含不同值的数组。一旦你有了它，你就可以实现下面的逻辑（类似于你已经拥有的公式）来生成你的结果。这些是工作表公式，但您应该能够在 VBA 中完成同样的事情。顺便说一句，cpearson 网站是 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