Excel VBA – 查找值的最小值？

对于像这样的列表：

Column1 Column2 Column3 DataA 1 1234 DataA 2 4678 DataA 3 8910 DataB 2 1112 DataB 4 1314 DataB 9 1516 

我如何获得这样的列表：

 Column4 Column5 Column6 DataA 1 1234 DataB 2 1112 

关键是只返回column2中的最小值和相应的column3值。

Answer 1

对不起，我首先误解了你的问题。 这是一个比我想要的更复杂的工作代码：D

 Option Explicit Private Function inCollection(ByRef myCollection As Collection, ByRef value As Variant) As Boolean Dim i As Integer inCollection = False For i = 1 To myCollection.Count If (myCollection(i) = value) Then inCollection = True Exit Function End If Next i End Function Sub listMinimums() Dim source As Range Dim target As Range Dim row As Range Dim i As Integer Dim datas As New Collection Dim minRows As New Collection Set source = Range("A2:C5") Set target = Range("D2") target.value = source.value For Each row In source.Rows With row.Cells(1, 1) If (inCollection(datas, .value) = False) Then datas.Add .value minRows.Add row.row, .value End If If (Me.Cells(minRows(.value), 2) > row.Cells(1, 2)) Then minRows.Remove (.value) minRows.Add row.row, .value End If End With Next row 'output' For i = 1 To minRows.Count target(i, 1) = Me.Cells(minRows(i), 1) target(i, 2) = Me.Cells(minRows(i), 2) target(i, 3) = Me.Cells(minRows(i), 3) Next i Set datas = Nothing Set minRows = Nothing End Sub 

注意：您可能想用您的工作表的名称replaceMe 。

Answer 2

一个使用ADO的例子。

 Dim cn As Object Dim rs As Object Dim strFile As String Dim strCon As String Dim strSQL As String Dim i As Integer ''http://support.microsoft.com/kb/246335 strFile = ActiveWorkbook.FullName strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _ & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";" Set cn = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") cn.Open strCon strSQL = "SELECT Column1, Min(Column3) As MinCol3 FROM [Sheet8$] GROUP BY Column1" rs.Open strSQL, cn, 3, 3 For i = 0 To rs.fields.Count - 1 Sheets("Sheet7").Cells(1, i + 1) = rs.fields(i).Name Next Worksheets("Sheet7").Cells(2, 1).CopyFromRecordset rs 

Answer 3

尝试这个：

 Public Sub MinList() Const clColKey_c As Long = 1& Const clColVal_c As Long = 3& Dim ws As Excel.Worksheet, objDict As Object Dim lRow As Long, dVal As Double, sKey As String Dim lRowFrst As Long, lRowLast As Long, lColOut As Long Set ws = Excel.ActiveSheet Set objDict = CreateObject("Scripting.Dictionary") lRowFrst = ws.UsedRange.Row lRowLast = ws.UsedRange.Rows.Count lColOut = ws.UsedRange.Columns.Count + 1& For lRow = lRowFrst To lRowLast dVal = Val(ws.Cells(lRow, clColVal_c).Value) sKey = ws.Cells(lRow, clColKey_c).Value If objDict.Exists(sKey) Then If dVal > objDict.Item(sKey) Then objDict.Item(sKey) = dVal Else objDict.Add sKey, dVal End If Next For lRow = lRowFrst To lRowLast ws.Cells(lRow, lColOut).Value = objDict.Item(ws.Cells(lRow, clColKey_c).Value) Next ws.Cells(1&, lColOut).Value = "Min" End Sub