[讨论]有点难度的汇总

泓()

加上以下代码,

可以输出看看,问题已经变简单了一些

[d1].Resize(dic.Count, 1) = WorksheetFunction.Transpose(dic.keys)
[e1].Resize(dic.Count, 1) = WorksheetFunction.Transpose(dic.items)

彭希仁

是的，各种方法都能做出来，但要做到简捷高效就不易啊

泓()

说得对，

以我目前所掌握的数组与字典　或我的知识(我的思维)，也已经穷尽了，这题很不错，我一定按我的思维先做完，

然后，学习他人的．

彭希仁

Sub peng()
    Dim x As Long
    Dim y As Long
    Dim z As Long
    Dim SQL$
    Dim d1 As New Dictionary
    Set cnn = CreateObject("adodb.connection")
    cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;imex=1';data source=" & ActiveWorkbook.FullName
    SQL = "SELECT 机型,故障,Count(故障) FROM[数据$A1:C65536] GROUP BY 机型,故障 ORDER BY 机型,Count(故障)"
    Set temp = cnn.Execute(SQL)
    zt = temp.GetRows
    ReDim arr(0 To UBound(zt, 2) * 2, 1 To 11)
    x = 0
    y = 0
    z = 0
    For i = 0 To UBound(zt, 2) - 1
        y = y + zt(2, i)
        z = z + 1
        arr(x, 1) = z
        arr(x, 2) = zt(0, i)
        arr(x, 3) = zt(1, i)
        arr(x, 4) = zt(2, i)
        d1.Add zt(0, i) & zt(1, i), x       '通过字典记录位置
        If zt(0, i) <> zt(0, i + 1) Then  '生成合计
            x = x + 1
            arr(x, 1) = z + 1
            arr(x, 2) = zt(0, i)
            arr(x, 3) = "合计"
            arr(x, 4) = y
            z = 0
            y = 0
        End If
        x = x + 1
    Next i
    arr(x, 1) = z + 1
    arr(x, 2) = zt(0, i)
    arr(x, 3) = "合计"
    arr(x, 4) = y
   
   
    For i = x To 0 Step -1
        If arr(i, 3) = "合计" Then y = arr(i, 4)
        arr(i, 5) = arr(i, 4) / y
    Next i
    SQL = "SELECT 省份,机型,故障,Count(省份) as 故障数量 FROM[数据$A1:C65536] GROUP BY 机型,故障,省份 ORDER BY 机型,故障,Count(省份)Desc"
    Set temp = cnn.Execute(SQL)
    zt = temp.GetRows
    x = 4
    For i = 0 To UBound(zt, 2)
        If i = 0 Then
            x = 4
        Else
            If zt(1, i) & zt(2, i) <> zt(1, i - 1) & zt(2, i - 1) Then x = 4
        End If
        x = x + 2
        If x < 11 Then
            arr(d1(zt(1, i) & zt(2, i)), x) = zt(0, i)
            arr(d1(zt(1, i) & zt(2, i)), x + 1) = zt(3, i)
        End If
    Next i
    cnn.Close
    Set cnn = Nothing
    Sheets("报表").Select
    Cells(3, 1).Resize(UBound(arr), 11) = arr
End Sub

写了一个又长又臭又慢的代码。

ldy888

楼上统计结果错误，数据缺失

northwolves

SQL = "SELECT 机型,故障,Count(故障) FROM[数据$A1:C65536] GROUP BY 机型,故障 ORDER BY 机型,Count(故障)"

SQL = "SELECT 省份,机型,故障,Count(省份) as 故障数量 FROM[数据$A1:C65536] GROUP BY 机型,故障,省份 ORDER BY 机型,故障,Count(省份)Desc"

count字段设置错误，可改为：

SQL = "SELECT 省份,机型,故障,Count(*) as 故障数量 FROM[数据$A1:C65536] GROUP BY 机型,故障,省份 ORDER BY 机型,故障,Count(*)Desc"

试试。

tycp

自定义数据类型加数组,60000测试,怎么在我的机子上有时是1秒多,有时是3秒多呢??怪事!

彭希仁

Sub peng()
    Dim x As Long
    Dim y As Long
    Dim z As Long
    Dim SQL$
    Dim d1 As New Dictionary
    Set cnn = CreateObject("adodb.connection")
    cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;imex=1';data source=" & ActiveWorkbook.FullName
    SQL = "SELECT 机型,故障,Count(*) FROM[数据$A1:C65536] GROUP BY 机型,故障 ORDER BY 机型,Count(*)"
    Set temp = cnn.Execute(SQL)
    zt = temp.GetRows
    ReDim arr(0 To UBound(zt, 2) * 2, 1 To 11)
    x = -1
    y = 0
    z = 0
    K = UBound(zt, 2)
    For i = 0 To K
        x = x + 1
        y = y + zt(2, i)
        z = z + 1
        arr(x, 1) = z
        arr(x, 2) = zt(0, i)
        arr(x, 3) = zt(1, i)
        arr(x, 4) = zt(2, i)
        d1.Add zt(0, i) & zt(1, i), x       '通过字典记录位置
        If i = K Then
            x = x + 1
            arr(x, 1) = z + 1
            arr(x, 2) = zt(0, i)
            arr(x, 3) = "合计"
            arr(x, 4) = y
        ElseIf zt(0, i) <> zt(0, i + 1) Then
            x = x + 1
            arr(x, 1) = z + 1
            arr(x, 2) = zt(0, i)
            arr(x, 3) = "合计"
            arr(x, 4) = y
            z = 0
            y = 0
        End If
    Next i

    For i = x To 0 Step -1
        If arr(i, 3) = "合计" Then y = arr(i, 4)
        arr(i, 5) = arr(i, 4) / y
    Next i
    SQL = "SELECT 省份,机型,故障,Count(*) as 故障数量 FROM[数据$A1:C65536] GROUP BY 机型,故障,省份 ORDER BY 机型,故障,Count(*)Desc"
    Set temp = cnn.Execute(SQL)
    zt = temp.GetRows
    x = 4
    For i = 0 To UBound(zt, 2)
        If i = 0 Then
            x = 4
        Else
            If zt(1, i) & zt(2, i) <> zt(1, i - 1) & zt(2, i - 1) Then x = 4
        End If
        x = x + 2
        If x < 11 Then
            arr(d1(zt(1, i) & zt(2, i)), x) = zt(0, i)
            arr(d1(zt(1, i) & zt(2, i)), x + 1) = zt(3, i)
        End If
    Next i
    cnn.Close
    Set cnn = Nothing
    Sheets("报表").Select
    Cells(3, 1).Resize(UBound(arr), 11) = arr
End Sub
出错原因是求和的时候少算最后一行.

[此贴子已经被作者于2007-11-29 18:58:25编辑过]

morganwong

用不着VBA

我还是那句话,要转换思维,此路不通,则彼路通!!

用辅助列的方式!!

WvJ9PvIW.rar (25.25 KB, 下载次数: 14)

2007-11-29 19:07 上传

点击文件名下载附件

[此贴子已经被作者于2007-11-29 19:07:20编辑过]

tycp

QUOTE:

以下是引用morganwong在2007-11-29 19:06:32的发言：

用不着VBA

我还是那句话,要转换思维,此路不通,则彼路通!!

用辅助列的方式!!

有点搞笑！！！