Excel VBA中SQL统计不同Packets对应的Diagrams与FinDate数量问题

需求：按[Packets]列分组，统计每个分组下[Diagrams]和[FinDate]的有效条数（空值不统计），数据表中[Packets]存在重复值。当前单列统计正常，添加第二个统计条件后运行报错。

原始数据表 #

期望输出结果 #

当前报错代码 #

Sub CountOfDiagrams_FinDate()

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

strFile = ThisWorkbook.FullName
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
  & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";;"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon

strSQL = "SELECT [Packets], " & _
         "COUNT([Diagrams]) AS AMOUNT, COUNT([FinDate]) AS AMOUNT " & _
         "FROM [MECHANICAL$] " & _
         "GROUP BY [Packets]"

rs.Open strSQL, cn

Sheets("Sheet1").Select

' row
Dim r As Integer
r = 2
' column
Dim c As Integer
c = 1

Cells(r, c).CopyFromRecordset rs

rs.Close
cn.Close

End Sub

问题原因及解决方法 #

1. 列别名重复：SQL语句中两个统计列的别名均为AMOUNT，导致字段名冲突，这是报错的直接原因。需将别名改为与统计列对应的名称，比如AS Diagrams和AS FinDate。
2. COUNT函数适配需求：COUNT([列名])会自动忽略该列的空值，刚好符合统计有效条数的要求，无需调整。

修正后的代码 #

Sub CountOfDiagrams_FinDate()

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim ws As Worksheet

strFile = ThisWorkbook.FullName
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
  & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Set ws = ThisWorkbook.Sheets("Sheet1") ' 直接指定工作表，避免激活操作

cn.Open strCon

' 修正SQL别名，确保字段名唯一
strSQL = "SELECT [Packets], " & _
         "COUNT([Diagrams]) AS Diagrams, COUNT([FinDate]) AS FinDate " & _
         "FROM [MECHANICAL$] " & _
         "GROUP BY [Packets]"

rs.Open strSQL, cn

' 直接在目标工作表写入数据
ws.Cells(2, 1).CopyFromRecordset rs

rs.Close
cn.Close

' 释放对象资源
Set rs = Nothing
Set cn = Nothing
Set ws = Nothing

End Sub

内容的提问来源于stack exchange，提问作者ryanm