Excel VBA - 최소 값 목록 찾기? 같은 목록

Question

:

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 

핵심 만 2 열에서 최소값 및 해당 3 열 값을 반환하는 것입니다.

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 

참고 : 시트의 이름으로 Me을 대체 할 수 있습니다.

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