删除重复数据取最小值

ppl123

老师帮忙用代码删除重复数据取最小值
Book1.rar (8.72 KB, 下载次数: 9)

2017-7-22 12:57 上传

点击文件名下载附件

凌空一羽

Sub lkyy()
Set cnn = CreateObject("ADODB.Connection")
cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties='excel 12.0;hdr=yes;imex=1';data source=" & ThisWorkbook.FullName
Sql = "Select distinct * from [sheet1$g:h] where 编号"
Sql = "select 编号,min(数量) from (" & Sql & ") group by 编号"
Range("a2").CopyFromRecordset cnn.Execute(Sql)
cnn.Close
Set cnn = Nothing
End Sub

ppl123

老师，运行错误，这里有个是取最大值http://club.excelhome.net/thread-1178894-2-1.html
但我要的是取最小值，我不会代码，老师在帮修改可以吗

ahnyt

看看是这个结果吗？

SSS2112

1. Sub SSS2112()
   
2. Dim Conn As Object, PathStr$, SQL$
   
3. Set Conn = CreateObject("ADODB.Connection")
   
4. PathStr = ActiveWorkbook.FullName
   
5. Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='excel 8.0;HDR=YES;imex=1';Data Source=" & PathStr
   
6. SQL = "SELECT 编号,Min(数量) From [Sheet1$G:H] GROUP BY 编号"
   
7. [A2].CopyFromRecordset Conn.Execute(SQL)
   
8. Conn.Close
   
9. Set Conn = Nothing
   
10. End Sub
    

复制代码

zax010

Sub zz()
    Dim d, ar
    Set d = CreateObject("Scripting.Dictionary")
    ar = [f1].CurrentRegion
    For i = 2 To UBound(ar)
        If Not d.exists(ar(i, 2)) Then
            d(ar(i, 2)) = ar(i, 3)
        Else
            If d(ar(i, 2)) > ar(i, 3) Then
                d(ar(i, 2)) = ar(i, 3)
            End If
        End If
    Next
    [A2].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
End Sub

zax010

Book1.rar (12.97 KB, 下载次数: 7)

2017-7-22 14:28 上传

点击文件名下载附件