在VBA中查找数组的模式

我正在尝试在VBA中find数组的模式。

假设有一个电影名称的dynamic列表。 A：A，还有一个刚刚出现的列表B：B，这是一个电影“types”的列表。

我试图find一个特定types的最重复的头衔。

注意：A：A是一个dynamic列表，我不知道它的长度。

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

以此表为例，“海底总动员”是发生次数最多的题目。 但现在我写一个函数来返回结果？

我假设一个类似于这样的function：

 =movieMode(5) 

其中5指定我要返回的“最高”结果的数量。

这里的问题是，当A：A处于dynamic长度时，我不知道该怎么做。 以及如何控制返回多less结果。 我应该设置一个filter，默认只search“漫画”。

请分享一下这个。

更新

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

 =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是Cartoon，并且当A'x'不是空的。 （这个公式似乎没有工作时，范围是空的。

这是我用excel公式的第一天，我已经遇到了这个。 大声笑

进一步更新

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

结果应该是

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

我期待“卡通”filter默认设置为function。 我从来不希望行动在任何时候出现，也不希望成为一个变数。

但是，如果我使用

 -movieMode(1) 

预期的结果是

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

Answer 1

这是一个使用脚本对象Dictionary的解决scheme，而不是非常有效的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