Скрытый текст |
---|
Код |
---|
Sub Totale()
Set cn = CreateObject("ADODB.Connection")
Set cmd = CreateObject("ADODB.Command")
Set rs = CreateObject("ADODB.Recordset")
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ActiveWorkbook.FullName & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES"";"
cn.Open
cmd.ActiveConnection = cn
cmd.CommandText = "SELECT Товар, Sum(`Кол-во`) AS `Кол-во` FROM [123$A:C] GROUP BY Товар ORDER BY Товар"
rs.Open cmd
For i = 0 To rs.Fields.Count - 1
With Лист4.Range("F1").Offset(, i)
.Value = rs.Fields(i).Name
.Font.Bold = True
End With
Next
Лист4.Range("F2").CopyFromRecordset rs
End Sub |
|
Цикл по именам полей - самый местозанимающий :-)
ну а сортировку по пользовательскому списку можно прикрутить отдельно, при этом ORDER BY Товар не обязателен.
Скрытый текст |
---|
Код |
---|
Sub TotaleS()
Set cn = CreateObject("ADODB.Connection")
Set cmd = CreateObject("ADODB.Command")
Set rs = CreateObject("ADODB.Recordset")
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ActiveWorkbook.FullName & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES"";"
cn.Open
cmd.ActiveConnection = cn
cmd.CommandText = "SELECT Товар, Sum(`Кол-во`) AS `Кол-во` FROM [123$A:C] GROUP BY Товар"
rs.Open cmd
For i = 0 To rs.Fields.Count - 1
With Лист4.Range("F1").Offset(, i)
.Value = rs.Fields(i).Name
.Font.Bold = True
End With
Next
Лист4.Range("F2").CopyFromRecordset rs
With ActiveWorkbook.Worksheets("123").Sort
.SortFields.Clear
.SortFields.Add Key:=Лист4.Range("F1").CurrentRegion.Resize(, 1), _
SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"Аи-92,Аи-95,G-95,ДТ,G-Drive 100,СУГ" _
, DataOption:=xlSortNormal
.SetRange Лист4.Range("F1").CurrentRegion
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
|
|