Excel VBA - Trouver un minimum de liste de valeurs?

Question

Pour une liste comme:

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

Comment puis-je obtenir une liste comme ceci:

Column4 Column5  Column6  
DataA  1   1234  
DataB  2   1112 

La clé est de ne retourner que la valeur minimale colonne2 et sa valeur colonne3 correspondante.

Answer 1

Désolé, j'ai mal compris votre question d'abord. Voici un code de travail qui a fini plus complexe que ce que je voulais que ce soit: 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 

Note: Vous pouvez remplacer Me avec le nom de votre feuille.

Answer 2

Un exemple utilisant 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

Essayez ceci:

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