[已解决]按条件统计，SQL，数组或者字典都行，只要能够实现

笨得很呀2007 · 发表于 2014-5-13 15:41

麻烦老师帮我看看附件中的求助，需要使用ADO的SQL语句来。如果能够用数组或者字典也行，反正只要能够完成就行。但是我明细中的数据一个月下来可能超过25W行，所以麻烦老师能够以ADO或者数组或者字典的方法来实现

SQL统计.zip (298.98 KB, 下载次数: 38)

2014-5-13 15:39 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2014-5-13 19:48

Sub Macro1()
Dim arr, brr, crr, d, d2, i&, zf$, zf2$, zf3$
Set d = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
Range("b2:l60000").ClearContents
arr = Sheet1.Range("a1").CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 5)
ReDim crr(1 To UBound(arr), 1 To 5)
zf = "中断访问+业务成功+完成问卷/不同意+指定预约"
zf2 = "完成问卷/不同意+业务成功"
zf3 = "业务成功"
For i = 2 To UBound(arr)
x = Split(arr(i, 16))(0)
If Not d.exists(x) Then
s = s + 1
d(x) = s
brr(s, 1) = x
brr(s, 2) = 1
If InStr(zf, arr(i, 15)) Then brr(s, 3) = 1
If InStr(zf2, arr(i, 15)) Then brr(s, 4) = 1
If arr(i, 15) = zf3 Then brr(s, 5) = 1
Else
brr(d(x), 2) = brr(d(x), 2) + 1
If InStr(zf, arr(i, 15)) Then brr(d(x), 3) = brr(d(x), 3) + 1
If InStr(zf2, arr(i, 15)) Then brr(d(x), 4) = brr(d(x), 4) + 1
If arr(i, 15) = zf3 Then brr(d(x), 5) = brr(d(x), 5) + 1
End If
If Not d2.exists(arr(i, 12)) Then
s2 = s2 + 1
d2(arr(i, 12)) = s2
crr(s2, 1) = arr(i, 12)
crr(s2, 2) = 1
If InStr(zf, arr(i, 15)) Then crr(s2, 3) = 1
If InStr(zf2, arr(i, 15)) Then crr(s2, 4) = 1
If arr(i, 15) = zf3 Then crr(s2, 5) = 1
Else
crr(d2(arr(i, 12)), 2) = crr(d2(arr(i, 12)), 2) + 1
If InStr(zf, arr(i, 15)) Then crr(d2(arr(i, 12)), 3) = crr(d2(arr(i, 12)), 3) + 1
If InStr(zf2, arr(i, 15)) Then crr(d2(arr(i, 12)), 4) = crr(d2(arr(i, 12)), 4) + 1
If arr(i, 15) = zf3 Then crr(d2(arr(i, 12)), 5) = crr(d2(arr(i, 12)), 5) + 1
End If
Next
Range("b2").Resize(s, 5) = brr
Range("h2").Resize(s2, 5) = crr
Range("b2").Resize(s, 5).Sort [b2], Header:=xlGuess
End Sub

复制代码

跳转到最佳答案楼层

笨得很呀2007 · 发表于 2014-5-13 17:43

顶一下。

dsmch · 发表于 2014-5-13 17:52

模拟几个结果，方便理解问题

笨得很呀2007 · 发表于 2014-5-13 18:10

模拟了结果，先谢谢了

dsmch · 发表于 2014-5-13 19:48

Sub Macro1()
Dim arr, brr, crr, d, d2, i&, zf$, zf2$, zf3$
Set d = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
Range("b2:l60000").ClearContents
arr = Sheet1.Range("a1").CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 5)
ReDim crr(1 To UBound(arr), 1 To 5)
zf = "中断访问+业务成功+完成问卷/不同意+指定预约"
zf2 = "完成问卷/不同意+业务成功"
zf3 = "业务成功"
For i = 2 To UBound(arr)
x = Split(arr(i, 16))(0)
If Not d.exists(x) Then
s = s + 1
d(x) = s
brr(s, 1) = x
brr(s, 2) = 1
If InStr(zf, arr(i, 15)) Then brr(s, 3) = 1
If InStr(zf2, arr(i, 15)) Then brr(s, 4) = 1
If arr(i, 15) = zf3 Then brr(s, 5) = 1
Else
brr(d(x), 2) = brr(d(x), 2) + 1
If InStr(zf, arr(i, 15)) Then brr(d(x), 3) = brr(d(x), 3) + 1
If InStr(zf2, arr(i, 15)) Then brr(d(x), 4) = brr(d(x), 4) + 1
If arr(i, 15) = zf3 Then brr(d(x), 5) = brr(d(x), 5) + 1
End If
If Not d2.exists(arr(i, 12)) Then
s2 = s2 + 1
d2(arr(i, 12)) = s2
crr(s2, 1) = arr(i, 12)
crr(s2, 2) = 1
If InStr(zf, arr(i, 15)) Then crr(s2, 3) = 1
If InStr(zf2, arr(i, 15)) Then crr(s2, 4) = 1
If arr(i, 15) = zf3 Then crr(s2, 5) = 1
Else
crr(d2(arr(i, 12)), 2) = crr(d2(arr(i, 12)), 2) + 1
If InStr(zf, arr(i, 15)) Then crr(d2(arr(i, 12)), 3) = crr(d2(arr(i, 12)), 3) + 1
If InStr(zf2, arr(i, 15)) Then crr(d2(arr(i, 12)), 4) = crr(d2(arr(i, 12)), 4) + 1
If arr(i, 15) = zf3 Then crr(d2(arr(i, 12)), 5) = crr(d2(arr(i, 12)), 5) + 1
End If
Next
Range("b2").Resize(s, 5) = brr
Range("h2").Resize(s2, 5) = crr
Range("b2").Resize(s, 5).Sort [b2], Header:=xlGuess
End Sub

复制代码

dsmch · 发表于 2014-5-13 19:49

………………

pengyx · 发表于 2014-5-13 19:49

试试不行就删了哈，没用Sql哈

笨得很呀2007 · 发表于 2014-5-13 22:57

多谢楼上的两位老师，两个都可以，非常感谢。

xpw6061 · 发表于 2014-5-13 23:30

笨得很呀2007 发表于 2014-5-13 17:43
顶一下。

SQL也是有解的

笨得很呀2007 · 发表于 2014-5-14 08:36

xpw6061 发表于 2014-5-13 23:30
SQL也是有解的

非常感谢，三位老师的回复都可以。谢谢

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

[已解决]按条件统计，SQL，数组或者字典都行，只要能够实现

点评

评分

评分

评分

评分