[已解决]SQL双条件求解决

张雄友 · 发表于 2014-3-1 19:20

本帖最后由张雄友于 2014-3-1 22:07 编辑

前几天发现SQL 中的威力很大，请帮解决附件重复劳动问题。

最佳答案

hwc2ycy

2014-3-1 20:00

Option Explicit
Dim AdoConn As Object
Dim AdoRst As Object
Dim AdoRst1 As Object
Const adUseClient = 3
Const adModeRead = 1
Sub test()
Dim i As Integer
Call OpenConnect(ThisWorkbook.FullName)
Set AdoRst = AdoConn.Execute("select 车间,组别,count(工号) as 计数,sum(收入) as 总收入,avg(收入) as 平均收入 from [明细$a1:f] group by 车间,组别")
With AdoRst
For i = 0 To AdoRst.Fields.Count - 1
Sheet1.Cells(1, i + 1).Value = AdoRst.Fields(i).Name
Next
End With
Sheet1.Range("a2").CopyFromRecordset AdoRst
End Sub
Function OpenConnect(strFullname) As Boolean
Dim StrConn$
On Error GoTo ErrorHandler
If AdoConn Is Nothing Then
Set AdoConn = CreateObject("ADODB.Connection")
Else
OpenConnect = True
Exit Function
End If
StrConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
"Data Source='" & strFullname & "';;Extended Properties='Excel 8.0;HDR=YES;imex=1';"
With AdoConn
.CursorLocation = adUseClient
.Mode = adModeRead
.ConnectionString = StrConn
.Open
End With
OpenConnect = True
Exit Function
ErrorHandler:
On Error Resume Next
MsgBox Err.Number & vbCrLf & _
Err.Description
Set AdoRst = Nothing
Set AdoConn = Nothing
End Function

复制代码

hwc2ycy · 发表于 2014-3-1 19:55

复制代码

张雄友 · 发表于 2014-3-1 19:56

hwc2ycy 发表于 2014-3-1 19:55

最后那个总数与平均数没有提取出来的？

hwc2ycy · 发表于 2014-3-1 20:00

Option Explicit
Dim AdoConn As Object
Dim AdoRst As Object
Dim AdoRst1 As Object
Const adUseClient = 3
Const adModeRead = 1
Sub test()
Dim i As Integer
Call OpenConnect(ThisWorkbook.FullName)
Set AdoRst = AdoConn.Execute("select 车间,组别,count(工号) as 计数,sum(收入) as 总收入,avg(收入) as 平均收入 from [明细$a1:f] group by 车间,组别")
With AdoRst
For i = 0 To AdoRst.Fields.Count - 1
Sheet1.Cells(1, i + 1).Value = AdoRst.Fields(i).Name
Next
End With
Sheet1.Range("a2").CopyFromRecordset AdoRst
End Sub
Function OpenConnect(strFullname) As Boolean
Dim StrConn$
On Error GoTo ErrorHandler
If AdoConn Is Nothing Then
Set AdoConn = CreateObject("ADODB.Connection")
Else
OpenConnect = True
Exit Function
End If
StrConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
"Data Source='" & strFullname & "';;Extended Properties='Excel 8.0;HDR=YES;imex=1';"
With AdoConn
.CursorLocation = adUseClient
.Mode = adModeRead
.ConnectionString = StrConn
.Open
End With
OpenConnect = True
Exit Function
ErrorHandler:
On Error Resume Next
MsgBox Err.Number & vbCrLf & _
Err.Description
Set AdoRst = Nothing
Set AdoConn = Nothing
End Function

复制代码

张雄友 · 发表于 2014-3-1 20:05

hwc2ycy 发表于 2014-3-1 20:00

最后那个总数与平均数没有提取出来的？

dsmch · 发表于 2014-3-1 20:58

Sub Macro1()
Dim arr, brr, w(1 To 3), d, i&, x$, s&, rng As Range
Set d = CreateObject("scripting.dictionary")
arr = Sheet2.Range("a1").CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 5)
For i = 2 To UBound(arr)
x = arr(i, 1) & "," & arr(i, 2)
If Not d.exists(x) Then
s = s + 1
d(x) = s
brr(s, 1) = arr(i, 1)
brr(s, 2) = arr(i, 2)
brr(s, 3) = 1
brr(s, 4) = arr(i, 5)
Else
brr(d(x), 3) = brr(d(x), 3) + 1
brr(d(x), 4) = brr(d(x), 4) + arr(i, 5)
End If
Next
For i = 1 To s
brr(i, 5) = brr(i, 4) / brr(i, 3)
For j = 1 To 2
w(j) = w(j) + brr(i, j + 2)
Next
w(3) = w(2) / w(1)
Next
Sheet1.Activate
[l:p].Clear
Range("l3").Resize(1, UBound(brr, 2)) = Array("车间", "组别", "计数项：组", "收入", "平均收入")
Range("l4").Resize(s, 5) = brr
[l3].CurrentRegion.Sort Key1:=[l4], Key2:=[m4], Header:=xlGuess
Set rng = Range("l4").Offset(s, 0)
rng = "总计": rng.Resize(1, 3).Offset(, 2) = w
rng.Resize(1, 2).Merge
With [l3].CurrentRegion.Borders()
.LineStyle = xlContinuous
.Weight = xlThin
End With
End Sub

复制代码

常规写法

hwc2ycy · 发表于 2014-3-1 21:41

张雄友发表于 2014-3-1 20:05
最后那个总数与平均数没有提取出来的？

你没测试代码看结果，不是有嘛。

张雄友 · 发表于 2014-3-1 21:47

hwc2ycy 发表于 2014-3-1 21:41
你没测试代码看结果，不是有嘛。

总计

808

312046

386

这个数哦？

hwc2ycy · 发表于 2014-3-1 21:53

张雄友发表于 2014-3-1 21:47
这个数哦？

你昨天是不是也发过一个类似的贴子，当时也是用SQL解决的。

张雄友 · 发表于 2014-3-1 21:56

hwc2ycy 发表于 2014-3-1 21:53
你昨天是不是也发过一个类似的贴子，当时也是用SQL解决的。

请看附件。

		自动登录	找回密码
密码			注册