Question

我试图在VBA中找到数组的模式。

假设有一个动态的电影片名列表。答：A，并且有一个同样长的列表B：B，这是一个电影“类型”列表。

我正在尝试找到某种类型的最重复的标题。

注意：答：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（这似乎是在范围内循环？）
我指定的范围内没有空格。

我需要改进这个公式，以便它需要E：E，其中type是卡通，当A'x'不为空时。（当范围为空时，这个公式似乎不起作用。

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

进一步更新

考虑到我上面给出的情景，我期待使用 = movieMode（2）

结果应为

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

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

但是，如果我使用

-movieMode(1)

预期结果是

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

Answer 1

以下是使用脚本对象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

输出：

enter image description here

Answer 2

使用此VBA function from cpearson.com返回仅包含不同值的数组。完成后，您可以实现下面的逻辑（类似于您已有的公式）来生成结果。这些是工作表公式，但您应该能够在VBA中完成相同的操作。顺便说一下，cpearson website对于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

在VBA中查找数组的模式

2 个答案: