如何提取Summary表未包含的客户数据并填充至ListBox？

我拥有两个工作表：Summary表和Data表。Summary表中包含特定客户编号的汇总数据，需要提取Data表中所有未在Summary表中出现的客户数据，按照Summary表的列结构（客户编号、客户名称、账龄、发票数量、金额）进行汇总，并将结果填充至ListBox组件中。

Summary表数据 #

Data表数据 #

原VBA代码问题分析 #

原代码存在以下关键错误：

1. SQL字段名不匹配：使用英文字段名，但实际工作表列名为中文，无法正确读取数据。
2. SQL语法错误：SELECT子句中字段间缺少逗号，导致SQL执行失败。
3. 连接字符串语法错误：.Open语句位置错误，需在设置完ConnectionString后单独调用。
4. 字符串处理错误：Getcust函数中截取字符串的长度计算错误，无法正确生成SQL IN子句所需格式。
5. ListBox数据赋值错误：rs.GetRows返回的是转置数组，直接赋值会导致数据列行颠倒。
6. ListBox清空方式错误：.Value = ""无法有效清空列表，应使用.Clear。

修正后的VBA代码 #

Option Explicit

Sub LoadUnlistedCustomersToLBox()
    Dim conn As Object, rs As Object, sqlStr As String, excludedCusts As String
    
    ' 创建并打开数据库连接
    Set conn = CreateObject("ADODB.Connection")
    With conn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & ThisWorkbook.FullName & _
                            ";Extended Properties=""Excel 12.0 Xml;HDR=Yes;IMEX=1"""
        .Open
    End With
    
    ' 获取需要排除的客户编号字符串
    excludedCusts = GetExcludedCustomers()
    
    ' 构建SQL查询语句：汇总未在Summary表中的客户数据
    sqlStr = "SELECT T1.[客户编号], T1.[客户名称], T1.[账龄], " & _
             "COUNT(T1.[发票编号]) AS [发票数量], SUM(T1.[金额]) AS [金额] " & _
             "FROM [Data$] T1 " & _
             "WHERE T1.[客户编号] NOT IN (" & excludedCusts & ") " & _
             "GROUP BY T1.[客户编号], T1.[客户名称], T1.[账龄]"
    
    ' 执行查询并获取结果集
    Set rs = conn.Execute(sqlStr)
    
    ' 将结果填充到ListBox
    If Not rs.EOF Then
        With Me.ListBox1
            .Clear
            ' 转置GetRows返回的数组，匹配ListBox的列行结构
            .Column = TransposeArray(rs.GetRows)
            .ColumnCount = rs.Fields.Count
            .ColumnWidths = "90,90,50,50,180"
        End With
    End If
    
    ' 清理资源
    rs.Close
    conn.Close
    Set rs = Nothing
    Set conn = Nothing
End Sub

' 获取Summary表中所有唯一客户编号，格式化为SQL IN子句需要的字符串
Private Function GetExcludedCustomers() As String
    Dim custDict As Object, custData As Variant, i As Long, result As String
    
    Set custDict = CreateObject("Scripting.Dictionary")
    ' 读取Summary表的客户编号列数据
    custData = Sheets("Summary").ListObjects(1).ListColumns("客户编号").DataBodyRange.Value
    
    ' 去重存储客户编号
    For i = LBound(custData, 1) To UBound(custData, 1)
        custDict(custData(i, 1)) = Empty
    Next i
    
    ' 拼接为带单引号的字符串，适配SQL IN语法
    If custDict.Count > 0 Then
        result = "'" & Join(custDict.Keys(), "','") & "'"
    Else
        ' 若没有需要排除的客户，返回一个永远不匹配的条件
        result = "'-1'"
    End If
    
    GetExcludedCustomers = result
End Function

' 转置二维数组，适配ListBox的Column属性要求
Private Function TransposeArray(inputArr As Variant) As Variant
    Dim outputArr As Variant, i As Long, j As Long
    Dim rows As Long, cols As Long
    
    rows = UBound(inputArr, 2) + 1
    cols = UBound(inputArr, 1) + 1
    
    ReDim outputArr(0 To rows - 1, 0 To cols - 1)
    
    For i = 0 To rows - 1
        For j = 0 To cols - 1
            outputArr(i, j) = inputArr(j, i)
        Next j
    Next i
    
    TransposeArray = outputArr
End Function

代码说明 #

1. 连接修正：修正ConnectionString语法，确保正确将Excel文件作为数据源打开。
2. SQL语句修正：使用中文列名，补充字段间逗号，保证语法正确且列结构与Summary表一致。
3. 客户编号去重：用Dictionary高效获取Summary表中的唯一客户编号，拼接成符合SQL IN子句的格式，避免重复判断。
4. 数组转置：新增TransposeArray函数，将ADODB返回的转置数组转换为ListBox所需结构，确保数据显示正确。
5. ListBox操作优化：使用.Clear清空列表，设置正确的列宽和列数。

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