筛选后计数求和的问题

gobin911

VBA代码，求助大神
要求：根据A列和K列筛选，然后排除重复项计数（重复项只计数一次）之后求和填入Sheet2表格中相应单元格
如，A列义乌管理部筛选，K列筛选红色，之后开始计数，重复项只计数一次，然后将计数汇总填入Sheet2中的B2单元格。

LMY123

'分解步骤，也可使用转置法，一次求得各种颜色报警
Sub ADO_红色()
    Dim Conn As Object, Rst As Object
    Dim strConn As String, strSQL As String
    Dim i As Integer, PathStr As String
    Set Conn = CreateObject("ADODB.Connection")
    Set Rst = CreateObject("ADODB.Recordset")
    PathStr = ThisWorkbook.FullName   '设置工作簿的完整路径和名称
    Select Case Application.Version * 1    '设置连接字符串,根据版本创建连接
    Case Is <= 11
        strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
    Case Is >= 12
        strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    End Select
    '设置SQL查询语句
    strSQL = "select 分行,count(预警等级) as 红色预警 from [Sheet1$] where 预警等级='" & Left(Sheet2.Cells(1, 2), 2) & "' GROUP BY 分行"
    Conn.Open strConn    '打开数据库链接
    Set Rst = Conn.Execute(strSQL)    '执行查询，并将结果输出到记录集对象
    With Sheet3
'        .Cells.Clear
        For i = 0 To Rst.Fields.Count - 1    '填写标题
            .Cells(1, i + 1) = Rst.Fields(i).Name
        Next i
        .Range("A2").CopyFromRecordset Rst
'        .Cells.EntireColumn.AutoFit  '自动调整列宽
'        .Cells.EntireColumn.AutoFit  '自动调整列宽
    End With
    Rst.Close    '关闭数据库连接
    Conn.Close
    Set Conn = Nothing
    Set Rst = Nothing
End Sub

Sub ADO_橙色()
    Dim Conn As Object, Rst As Object
    Dim strConn As String, strSQL As String
    Dim i As Integer, PathStr As String
    Set Conn = CreateObject("ADODB.Connection")
    Set Rst = CreateObject("ADODB.Recordset")
    PathStr = ThisWorkbook.FullName   '设置工作簿的完整路径和名称
    Select Case Application.Version * 1    '设置连接字符串,根据版本创建连接
    Case Is <= 11
        strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
    Case Is >= 12
        strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    End Select
    '设置SQL查询语句
    strSQL = "select count(预警等级) as 橙色预警 from [Sheet1$] where 预警等级='" & Left(Sheet2.Cells(1, 2), 2) & "' GROUP BY 分行"
    Conn.Open strConn    '打开数据库链接
    Set Rst = Conn.Execute(strSQL)    '执行查询，并将结果输出到记录集对象
    With Sheet3
'        .Cells.Clear
        For i = 0 To Rst.Fields.Count - 1    '填写标题
            .Cells(1, i + 3) = Rst.Fields(i).Name
        Next i
        .Range("C2").CopyFromRecordset Rst
'        .Cells.EntireColumn.AutoFit  '自动调整列宽
'        .Cells.EntireColumn.AutoFit  '自动调整列宽
    End With
    Rst.Close    '关闭数据库连接
    Conn.Close
    Set Conn = Nothing
    Set Rst = Nothing
End Sub

gobin911

LMY123 发表于 2018-10-18 17:35
'分解步骤，也可使用转置法，一次求得各种颜色报警
Sub ADO_红色()
    Dim Conn As Object, Rst As Obje ...

额，怎么这么复杂。。。。而且会显示错误啊。。。显示自动化错误