降序升序返回文本自定义函数分享交流

asdfghjklzz

工作需要制作的自定义函数公式，目的是根据输入的排名找到单元格中的最大值或最小值，并返回相应的文本。今天分享出来，希望各位大神能帮我看看是否有不足之处，或者是否可以优化思路和步骤。此外，如果论坛里有类似的帖子也请指点一二。
帖子中只包含了降序排序的部分，升序排序的代码已附在附件中。
另外，我是自学VBA的，变量名称和代码格式可能不够规范，欢迎大家提出改进意见。

1.降序排序

LARGES(Index As Variant, Array_Number As Range, Array_Text As Range, Format_Text As Variant, Optional IsTrue0 As Boolean = True) As Variant

参数1：Index 输入排名序号，例如"1"。如果一个单元格内需要返回多个排名则以"|"分割：例如"1|2|3"则会返回1、2、3名
参数2：Array_Number 输入数值单元格
参数3：Array_Text 输入需要返回的文本单元格
参数4：Format_Text 输入返回的文本格式。
参数5：IsTrue0  输入是否包含0值，默认是，如果数值有0值，则数值和文本都会返回空白。

需要注意 Format_Text ：其中index是序号，Text是文本。Number是数值。
例如："第index名是TextNumber数值分"。格式文本中：index、Text、Number需要手动输入。
"Number"：是默认常规格式。
"Number比例"：会让数值输出百分比格式。
"Number千分"：会让数值输出千分位格式。
"Number数值"：会让数值输出两位小数格式。
使用这种方式是因为有时需要返回的格式不固定：
数值、数值、数值；
文本、文本、文本；
文本（数值)、文本（数值)、文本（数值)。

2.并列排名
LARGESS(Index As Variant, Array_Number As Range, Array_Text As Range, Format_Text As Variant, Optional IsTrue0 As Boolean = True) As Variant
只有参数1与上面的不同。Index 只能有1个"|"分割。
例如写"2|3"，意思是前2名，最少3个数。
如果第1名有并列1个数，第2名有并列1个数，则返回第1、2名，2个数值；
如果第1名有并列2个数，第2名有并列3个数，则返回第1、2名，5个数值；
如果第1名有并列3个数，第2名有并列2个数，则返回第1名，3个数值；

3.自定义函数思路是：循环所有数值单元格，使用max找到最大值，根据最大值查找对应序号，根据需要查找对应文本。将Format_Text 文本格式内的英文替换为找到的排序、数值、文本，判断是否需要返回多个序号，判断是否保留0值，使用"、"连接返回的多个数据。

4.附件内代码较长较乱，劳烦各位大神写明优化思路或具体优化位置。

附件数据由网上随机生成。

asdfghjklzz

以下是降序排序代码，其他升序排序、并列降序、并列升序都在主贴的附件内。

1. Function LARGES(Index As Variant, Array_Number As Range, Array_Text As Range, Format_Text As Variant, Optional IsTrue0 As Boolean = True) As Variant
   
2.     '降序(排名数值,数值单元格,对应文本单元格,返回格式,是否保留0值)
   
3.     '排名数值 = "第1名|第2名|第3名|..."
   
4.     Dim i As Long
   
5.     Dim ArrayLength As Long '数组长度
   
6.     Dim ArrayCount As Long '数组计数项
   
7.     Dim NumArray() As Double '数值数组
   
8.     Dim TextArray() As String '文本数组
   
9.     Dim NewNumArray() As Variant '新数值数组
   
10.     Dim NewTextArray() As Variant '新文本数组
    
11.     Dim Result() As String '输出数组
    
12.     Dim ResultValue As String '输出文本
    
13.     Dim Format_Number As String '输出数值格式
    
14.     Dim MaxValue As Double '最大值数值
    
15.     Dim MaxIndex As Long '最大值序号
    
16.     '判断传入是单元格则改为单元格内容
    
17.     If TypeName(Index) <> "String" Then Index = Index.Value
    
18.     If TypeName(Format_Text) <> "String" Then Format_Text = Format_Text.Value
    
19.     '获取范围的单元格数量
    
20.     ArrayLength = Array_Number.Cells.Count
    
21.     '确定数组大小
    
22.     ReDim NumArray(1 To ArrayLength): ReDim TextArray(1 To ArrayLength)
    
23.     ReDim NewNumArray(1 To ArrayLength): ReDim NewTextArray(1 To ArrayLength)
    
24.     '将单元格值和文本存入数组
    
25.     For i = 1 To ArrayLength
    
26.         If IsNumeric(Array_Number.Cells(i).Value) Then
    
27.             NumArray(i) = Array_Number.Cells(i).Value
    
28.             TextArray(i) = Array_Text.Cells(i).Value
    
29.         Else
    
30.             NumArray(i) = 0
    
31.             TextArray(i) = Array_Text.Cells(i).Value
    
32.         End If
    
33.     Next i
    
34.     '查找行最大值并重置数组
    
35.     ArrayCount = 1
    
36.     Do While True
    
37.         MaxValue = Application.WorksheetFunction.Max(NumArray)
    
38.         MaxIndex = Application.Match(MaxValue, NumArray, 0)
    
39.         ' 如果没有找到最大值，退出循环
    
40.         If MaxValue = -1E+308 Then
    
41.             Exit Do
    
42.         Else
    
43.             NewNumArray(ArrayCount) = NumArray(MaxIndex)
    
44.             NewTextArray(ArrayCount) = TextArray(MaxIndex)
    
45.         End If
    
46.         ' 将原 NumArray 中的该值设为 -1E+308
    
47.         NumArray(MaxIndex) = -1E+308
    
48.         ' 增加新数组的索引
    
49.         ArrayCount = ArrayCount + 1
    
50.     Loop
    
51.     Number = "Number": Format_Number = "General Number" '默认常规
    
52.     Select Case 0
    
53.         Case Is < InStr(Format_Text, "数值"): Number = "Number数值": Format_Number = "Fixed" '数值
    
54.         Case Is < InStr(Format_Text, "千分"): Number = "Number千分": Format_Number = "Standard" '千分位符号
    
55.         Case Is < InStr(Format_Text, "比例"): Number = "Number比例": Format_Number = "Percent" '百分比
    
56.     End Select
    
57.     '判断序号是否有"|"，格式化数组
    
58.     If InStr(Index, "|") = 0 Then
    
59.         ResultValue = Replace(Format_Text, "Text", NewTextArray(Index), , , vbTextCompare) '替换Text,不区分大小写
    
60.         ResultValue = Replace(ResultValue, Number, Format(NewNumArray(Index), Format_Number)) '替换Number
    
61.         ResultValue = Replace(ResultValue, "Index", Index, , , vbTextCompare) '替换Index
    
62.         If IsTrue0 Then
    
63.             LARGES = ResultValue
    
64.         ElseIf IsTrue0 = False Then
    
65.             If NewNumArray(Index) = 0 Then ResultValue = ""
    
66.             LARGES = ResultValue
    
67.         End If
    
68.     Else
    
69.         Index = Split(Index, "|")
    
70.         '将排名放入格式化后的数组
    
71.         For i = LBound(Index) To UBound(Index)
    
72.             ResultValue = Replace(Format_Text, "Text", NewTextArray(Index(i)), , , vbTextCompare) '替换
    
73.             ResultValue = Replace(ResultValue, Number, Format(NewNumArray(Index(i)), Format_Number)) '替换
    
74.             ResultValue = Replace(ResultValue, "Index", Index(i), , , vbTextCompare) '替换Index
    
75.             If IsTrue0 Then
    
76.                 ReDim Preserve Result(i)
    
77.                 Result(i) = ResultValue
    
78.             ElseIf IsTrue0 = False And NewNumArray(i + 1) <> 0 Then
    
79.                 ReDim Preserve Result(i)
    
80.                 Result(i) = ResultValue
    
81.             End If
    
82.         Next i
    
83.         LARGES = Join(Filter(Result(), ""), "、")
    
84.     End If
    
85. End Function
    

复制代码