vba中excel列表中几个variables的最大值

我有一个如下所示的列表，但> 100k行。 我想find列表中每个字母的最大值。 需要vba中的解决scheme而不是工作表函数。

字母值
 A. 100
 B. 200
 C. 300
 A. 250
 B. 150
 A. 200
 C.350

Answer 1

最好的方法是使用Dictionary对象。 下面是代码介绍如何实现它（代码中的注释）：

 Public Sub findMaxValues() Dim wks As Excel.Worksheet Dim data As Variant Dim dict As Object Dim row As Long Dim letter As String Dim value As Double '--------------------------------------------------------- Dim varKey As Variant '--------------------------------------------------------- 'Read the data into array (for better performance). 'I assumed that data starts in the cell A1 of the currently active worksheet. If not, 'change the code below properly. Set wks = Excel.ActiveSheet data = wks.Cells(1, 1).CurrentRegion Set dict = VBA.CreateObject("Scripting.Dictionary") dict.CompareMode = vbTextCompare 'Iterate through all the rows of the array (start from the second row to skip headers). For row = LBound(data, 1) + 1 To UBound(data, 1) letter = VBA.Trim(data(row, 1)) value = data(row, 2) 'For each row check if the letter assigned to this row has been already added to the dictionary. If dict.Exists(letter) Then 'If letter has been added before, check if the current value is greater than the previous one 'and override it, if it is. If value > dict.Item(letter) Then dict.Item(letter) = value End If Else 'If letter has not been added to the dictionary before, add it with the current value. Call dict.Add(letter, value) End If Next row 'At this point, we have dictionary with as many items as many letters are in the worksheet. 'Each item has a letter as a key and this letter's max value as a value. 'To check it, let's print it in Immediate window. For Each varKey In dict.Keys Debug.Print varKey & ": " & dict.Item(varKey) Next varKey End Sub 

Answer 2

ADO方法

 Private Sub Workbook_Open() Dim objAdCon, objAdRs, strSQL Set objAdCon = CreateObject("ADODB.Connection") With objAdCon .Provider = "Microsoft.Jet.OLEDB.4.0" .ConnectionString = "Data Source=C:\Users\pankaj.jaju\Desktop\test.xls;Extended Properties=""Excel 8.0;HDR=Yes;""" .Open End With strSQL = "select letter, max(value) from [Sheet1$] group by letter" Set objAdRs = objAdCon.Execute(strSQL) Sheet1.Range("D1").CopyFromRecordset objAdRs End Sub 

结果