输出string而不是VBA max函数的值

所以我有一个函数来查找几个类别的最大值。 而不是将值保存到我的“最大”。 我想保存对应于最大值的string/文本。 这是我的：

StartCell.Select StartCell.Offset(1, 28).Activate For i = 1 To Count Select Case ActiveCell.Value Case "XX" ActiveCell.Offset(1, 0).Activate Case "0" ActiveCell.Offset(1, 0).Activate Case "DP0" DP0Count = DP0Count + 1 ActiveCell.Offset(1, 0).Activate Case "DP1" DP1Count = DP1Count + 1 ActiveCell.Offset(1, 0).Activate Case "DP2" DP2Count = DP2Count + 1 ActiveCell.Offset(1, 0).Activate Case "VP1" VP1Count = VP1Count + 1 ActiveCell.Offset(1, 0).Activate Case "VP2" VP2Count = VP2Count + 1 ActiveCell.Offset(1, 0).Activate Case "MP1" MP1Count = MP1Count + 1 ActiveCell.Offset(1, 0).Activate End Select Next i Max = WorksheetFunction.Max(DP0Count, DP1Count, DP2Count, VP1Count, VP2Count, MP1Count) MsgBox Max 

我想输出看起来像这样，最大值= DP2而不是数值

有任何想法吗？

Answer 1

我想这是你要找的。 不清楚如果有两个或更多的“最大”值，你将如何处理关系。

 Sub Tester() Dim c As Range Dim arrVals() As Long, arrNames, v As Long, vMax As Long, i As Long, m arrNames = Array("DPO", "DP1", "DP2", "VP1", "VP2", "MP1") ReDim arrVals(0 To UBound(arrNames)) Set c = StartCell.Offset(1, 28) For i = 1 To Count If c.Value = "XX" Or c.Value = "0" Then Set c = c.Offset(0, 1) Else m = Application.Match(c.Value, arrNames, 0) If Not IsError(m) Then arrVals(m - 1) = arrVals(m - 1) + 1 Set c = c.Offset(1, 0) End If End If Next i vMax = Application.Max(arrVals) MsgBox arrNames(Application.Match(vMax, arrVals, 0) - 1) End Sub