Excel VBA自定义函数开发：跨数据集计算受影响公民总数

• 功能目标：通过数据验证生成的动态公司选择列表，选中后自动计算受影响公民总数。
• 数据集结构：
  • 公司表：包含公司名称及对应运营国家代码；
  • 国家表：包含国家代码及对应公民数量。
• 计算规则：仅当2家及以上选中公司在某国运营时，该国公民数才计入统计。
• 示例：选中Company 4和Company 6时，二者均在AZ、BJ运营，输出应为732+347=1079。
• 限制：支持最多20个公司选择。
• 现有问题：使用Index/Match无法返回数组，自行编写的VBA函数逻辑不完善，需修正或重构。

现有尝试代码 #

Function Impact(CompanySelection As Range, CompanyTable As Range, CountryTable As Range)
Dim CountryCodes As Object
Dim LookupCountries As Object
Dim Results As Object
Dim CImpact As Long

Dim cell As Variable

For Each cell In CompanySelection.Range

    If cell.Value = "" Then
    Exit For

    CountryCodes.Add Application.WorksheetFunction.Index(CompanyTable, Application.WorksheetFunction.Match(cell, CompanyTable, 0), 2)
    CountryCodes.Add Application.WorksheetFunction.Index(CompanyTable, Application.WorksheetFunction.Match(cell, CompanyTable, 0), 3)
    CountryCodes.Add Application.WorksheetFunction.Index(CompanyTable, Application.WorksheetFunction.Match(cell, CompanyTable, 0), 4)
    CountryCodes.Add Application.WorksheetFunction.Index(CompanyTable, Application.WorksheetFunction.Match(cell, CompanyTable, 0), 5)


Next

For each cell in CountryCodes 

count # of occurances of each unique country code


If code in CountryCodes occurs >=2 Then
    LookupCountries.Add Value

For Each cell In LookupCountries

    Result.Add Application.WorksheetFunction.Index(CountryTable, 
Application.WorksheetFunction.Match(cell, CountryTable, 2))

Next


For Each cell In Result
CImpact = CImpact + cell.Value
Next

Impact = CImpact
End Function

相关表格 #

公司表 #

国家表 #

公司选择表 #

输出单元格 #

| 受影响公民数= |

修正后的VBA函数 #

Function CalculateAffectedCitizens(CompanySelection As Range, CompanyTable As Range, CountryTable As Range) As Long
    Dim countryDict As Object
    Dim cell As Range
    Dim companyRow As Variant
    Dim col As Integer
    Dim countryCode As String
    Dim citizenCount As Variant
    Dim total As Long
    
    ' 初始化字典用于统计国家出现次数
    Set countryDict = CreateObject("Scripting.Dictionary")
    
    ' 遍历选中的公司
    For Each cell In CompanySelection
        If cell.Value = "" Then Exit For ' 遇到空单元格停止
        
        ' 查找公司在公司表中的行
        companyRow = Application.Match(cell.Value, CompanyTable.Columns(1), 0)
        If IsError(companyRow) Then GoTo NextCell ' 未找到公司则跳过
        
        ' 遍历该公司对应的所有国家列（第2到第4列）
        For col = 2 To 4
            countryCode = CompanyTable.Cells(companyRow, col).Value
            If countryCode <> "" Then
                ' 统计国家出现次数
                If countryDict.Exists(countryCode) Then
                    countryDict(countryCode) = countryDict(countryCode) + 1
                Else
                    countryDict(countryCode) = 1
                End If
            End If
        Next col
        
NextCell:
    Next cell
    
    ' 筛选出出现次数>=2的国家，并计算公民总数
    total = 0
    For Each countryCode In countryDict.Keys
        If countryDict(countryCode) >= 2 Then
            ' 查找国家对应的公民数量
            citizenCount = Application.VLookup(countryCode, CountryTable, 2, False)
            If Not IsError(citizenCount) Then
                total = total + citizenCount
            End If
        End If
    Next countryCode
    
    CalculateAffectedCitizens = total
End Function

修正说明 #

1. 对象初始化：使用Scripting.Dictionary高效统计国家代码出现次数，解决原代码未初始化对象的问题；
2. 错误处理：增加未找到公司的判断逻辑，避免函数报错；
3. 遍历优化：动态遍历公司的国家列，无需硬编码列数，适配现有表格结构；
4. 空值过滤：跳过空的国家代码，避免无效统计；
5. 匹配简化：用VLookup替代原代码中不完善的Index/Match组合，简化国家到公民数的匹配逻辑；
6. 可读性提升：修改函数和变量名，让代码逻辑更清晰。

使用方法 #

在输出单元格中输入公式：

=CalculateAffectedCitizens(公司选择表的范围, 公司表的整个数据范围, 国家表的整个数据范围)

示例：若公司选择范围为A2:A21，公司表在Sheet1!A1:D7，国家表在Sheet2!A1:B12，公式为：

=CalculateAffectedCitizens(A2:A21, Sheet1!A1:D7, Sheet2!A1:B12)

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