Excel如何不生成辅助列计算公司平均分并找最高值？函数或VBA实现

嘿，这个需求完全可以搞定！不管是用纯Excel函数（不用额外辅助列）还是VBA，都有现成的方案，我给你拆解清楚：

一、无需辅助列的函数实现方案 #

当然可以直接用函数实现，不用生成存储平均分的辅助列，分两种Excel版本情况：

1. 适用于Excel 365/2021（动态数组） #

假设你的公司名称在A2:A6，对应分数在B2:B6，直接在任意空白单元格输入下面的公式，就能直接返回平均分最高的公司：

=INDEX(A2:A6,MATCH(MAX(AVERAGEIF(A2:A6,A2:A6,B2:B6)),AVERAGEIF(A2:A6,A2:A6,B2:B6),0))

简单说下原理：

• AVERAGEIF(A2:A6,A2:A6,B2:B6) 会生成一个动态数组，每个位置对应该行公司的平均分（比如两个Apple的位置都会显示(5+4)/2=4.5）
• MAX(...) 从这个数组里揪出最高的平均分
• 最后用INDEX+MATCH组合，找到这个最高分对应的公司名称

2. 适用于旧版Excel（非动态数组） #

公式和上面完全一样，但输入完后必须按 Ctrl+Shift+Enter 触发数组计算（不能直接回车），不然会返回错误值。

二、VBA实现方案 #

如果觉得函数的数组逻辑有点绕，或者需要批量处理多组数据，用VBA写自定义函数或者宏会更灵活：

1. 自定义函数（直接在单元格调用） #

按Alt+F11打开VBA编辑器，右键插入一个模块，然后粘贴下面的代码：

Function GetTopCompany(rngCompanies As Range, rngScores As Range) As String
    Dim scoreDict As Object
    Dim i As Integer
    Dim avgScore As Double, maxAvg As Double
    Dim topCompany As String
    
    ' 创建字典存储公司的总分和计数
    Set scoreDict = CreateObject("Scripting.Dictionary")
    
    ' 遍历所有数据，累加总分和计数
    For i = 1 To rngCompanies.Cells.Count
        Dim companyName As String
        companyName = rngCompanies.Cells(i).Value
        If scoreDict.Exists(companyName) Then
            ' 已有公司：累加分数和计数
            scoreDict(companyName)(0) = scoreDict(companyName)(0) + rngScores.Cells(i).Value
            scoreDict(companyName)(1) = scoreDict(companyName)(1) + 1
        Else
            ' 新公司：初始化总分和计数
            scoreDict.Add companyName, Array(rngScores.Cells(i).Value, 1)
        End If
    Next i
    
    ' 遍历字典找出最高平均分的公司
    maxAvg = 0
    For Each key In scoreDict.Keys
        avgScore = scoreDict(key)(0) / scoreDict(key)(1)
        If avgScore > maxAvg Then
            maxAvg = avgScore
            topCompany = key
        End If
    Next key
    
    ' 返回结果
    GetTopCompany = topCompany
End Function

回到Excel后，直接在单元格输入=GetTopCompany(A2:A6,B2:B6)，就能得到结果，和普通函数一样好用。

2. 一次性处理宏（适合单次批量操作） #

如果只是想一次性计算结果，不用自定义函数，可以写个宏：

Sub FindTopCompany()
    Dim scoreDict As Object
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Integer
    Dim avgScore As Double, maxAvg As Double
    Dim topCompany As String
    
    ' 取当前活动工作表
    Set ws = ActiveSheet
    ' 获取A列最后一行数据
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set scoreDict = CreateObject("Scripting.Dictionary")
    
    ' 读取数据到字典
    For i = 2 To lastRow
        Dim companyName As String
        companyName = ws.Cells(i, "A").Value
        If scoreDict.Exists(companyName) Then
            scoreDict(companyName)(0) = scoreDict(companyName)(0) + ws.Cells(i, "B").Value
            scoreDict(companyName)(1) = scoreDict(companyName)(1) + 1
        Else
            scoreDict.Add companyName, Array(ws.Cells(i, "B").Value, 1)
        End If
    Next i
    
    ' 找出最高平均分的公司
    maxAvg = 0
    For Each key In scoreDict.Keys
        avgScore = scoreDict(key)(0) / scoreDict(key)(1)
        If avgScore > maxAvg Then
            maxAvg = avgScore
            topCompany = key
        End If
    Next key
    
    ' 把结果输出到C1和C2单元格
    ws.Range("C1").Value = "表现最佳公司：" & topCompany
    ws.Range("C2").Value = "平均分：" & Round(maxAvg, 2)
End Sub

按F5运行宏，结果会自动输出到当前工作表的C1和C2单元格，还会把平均分保留两位小数。

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