[已解决]（明天要用，大侠帮帮忙！！）excel自定义函数，将一个数的数位重排后得出最大值、...

cmjcmj8888

求助：编写excel自定义函数。输入一个数，将这个数的数位重排后，得出最大值、最小值。
如：在单元格A1中输入1374，在B1中得最大值7431，在C1中得最小值1347
哪位大侠帮帮忙！！！

最佳答案

月排行榜 / 总排行榜

美斯特邦威

2013-10-7 16:36

cmjcmj8888 发表于 2013-10-7 16:34
不行啊。
求助：编写excel自定义函数。输入一个数，将这个数的数位重排后，得出最大值、最小值。
如：在 ...

见截图，还是不明白就爱莫能助了

跳转到最佳答案楼层

hwc2ycy

数值由大到小排好序后，可直接得出你要的数。

上清宫主

Sub test()
Dim ar1$(0 To 9), ar2$(0 To 9)
s$ = "3780908"
For i% = 1 To Len(s)
   c% = Mid(s, i, 1)
   ar1(c) = ar1(c) & c
   ar2(9 - c) = ar2(9 - c) & c
Next
[a1] = "'" & Replace(Join(ar1, "|"), "|", "")
[a2] = "'" & Replace(Join(ar2, "|"), "|", "")
End Sub

hwc2ycy

1. Sub test()
   
2.     Dim strMax$, strMin$, strTemp$
   
3.     strTemp = 432567
   
4.     getNewNumber strTemp, strMax, strMin
   
5.     MsgBox strTemp & vbCrLf & "最大值：" & strMax & vbCrLf & "最小值：" & strMin
   
6.     strTemp = 29427823023#
   
7.     getNewNumber strTemp, strMax, strMin
   
8.     MsgBox strTemp & vbCrLf & "最大值：" & strMax & vbCrLf & "最小值：" & strMin
   
9. 
   
10. End Sub
    
11. 
    
12. Function getNewNumber(lNumber As String, ByRef strMax$, ByRef strMin$) As String
    
13. '参数可传入纯数值或数值型字符串,不能带小数点，不能是科学计数法表示的数字
    
14.     Dim bOdd As Byte, bEven As Byte
    
15.     Dim i As Integer
    
16.     Dim lSum As Long
    
17.     Dim bTemp As Byte
    
18.     '检测参数是否是数字
    
19.     If lNumber Like "*[.Ee]*" Then Exit Function
    
20.     If Not VBA.IsNumeric(lNumber) Then Exit Function
    
21.     Dim arr()
    
22.     ReDim arr(1 To Len(lNumber))
    
23.     For i = 1 To UBound(arr)
    
24.         arr(i) = Val(Mid(lNumber, i, 1))
    
25.     Next
    
26.     QuickSort arr
    
27.     strMax = getMax(arr)
    
28.     strMin = getMin(arr)
    
29. End Function
    
30. 
    
31. 
    
32. Public Sub QuickSort(ByRef lngArray)
    
33.     Dim iLBound As Long
    
34.     Dim iUBound As Long
    
35.     Dim iTemp As Long
    
36.     Dim iOuter As Long
    
37.     Dim iMax As Long
    
38.     iLBound = LBound(lngArray)
    
39.     iUBound = UBound(lngArray)
    
40.     '若只有一个值，不排序
    
41.     iMax = 1
    
42.     If (iUBound - iLBound) Then
    
43.         For iOuter = iLBound To iUBound
    
44.             If lngArray(iOuter) > lngArray(iMax) Then iMax = iOuter
    
45.         Next iOuter
    
46.         iTemp = lngArray(iMax)
    
47.         lngArray(iMax) = lngArray(iUBound)
    
48.         lngArray(iUBound) = iTemp
    
49.         '开始快速排序
    
50.         InnerQuickSort lngArray, iLBound, iUBound
    
51.     End If
    
52. End Sub
    
53. 
    
54. Private Sub InnerQuickSort(ByRef lngArray, ByVal iLeftEnd As Long, ByVal iRightEnd As Long)
    
55.     Dim iLeftCur As Long
    
56.     Dim iRightCur As Long
    
57.     Dim iPivot As Byte
    
58.     Dim iTemp As Byte
    
59.     If iLeftEnd >= iRightEnd Then Exit Sub
    
60.     iLeftCur = iLeftEnd
    
61.     iRightCur = iRightEnd + 1
    
62.     iPivot = lngArray(iLeftEnd)
    
63.     Do
    
64.         Do
    
65.             iLeftCur = iLeftCur + 1
    
66.         Loop While lngArray(iLeftCur) < iPivot
    
67.         Do
    
68.             iRightCur = iRightCur - 1
    
69.         Loop While lngArray(iRightCur) > iPivot
    
70.         If iLeftCur >= iRightCur Then Exit Do
    
71.         '交换值
    
72. 
    
73.         iTemp = lngArray(iLeftCur)
    
74.         lngArray(iLeftCur) = lngArray(iRightCur)
    
75.         lngArray(iRightCur) = iTemp
    
76.     Loop
    
77.     '递归快速排序
    
78. 
    
79.     lngArray(iLeftEnd) = lngArray(iRightCur)
    
80.     lngArray(iRightCur) = iPivot
    
81.     InnerQuickSort lngArray, iLeftEnd, iRightCur - 1
    
82.     InnerQuickSort lngArray, iRightCur + 1, iRightEnd
    
83. End Sub
    
84. 
    
85. Function getMax(ByRef arr) As String
    
86.     getMax = StrReverse(Join(arr, ""))
    
87. End Function
    
88. 
    
89. Function getMin(ByRef arr) As String
    
90.     getMin = Join(arr, "")
    
91. End Function

复制代码

cmjcmj8888

上清宫主 发表于 2013-10-7 08:34
Sub test()
Dim ar1$(0 To 9), ar2$(0 To 9)
s$ = "3780908"

这只是对"3780908"进行了排列。
最好是自定义函数，对单元格A1中的任何数重排，得最大值、最小值。如：234159，得最大值954321，最小值123459.

cmjcmj8888

hwc2ycy 发表于 2013-10-7 09:09

这么多，那段是的？？
试了，好像都不行啊？？？？求大侠！！！！
求助：excel自定义函数，将一个数的数位重排后得出最大值、最小值。如：单元格A1为23419，则A2为最大值94321，A3为最小值12349.

cmjcmj8888

cmjcmj8888 发表于 2013-10-7 14:33
这么多，那段是的？？
试了，好像都不行啊？？？？求大侠！！！！
求助：excel自定义函数，将一个数的数 ...

拜托大侠行行好，帮帮忙！！！！！！！！！！！！

美斯特邦威

cmjcmj8888 发表于 2013-10-7 14:40
拜托大侠行行好，帮帮忙！！！！！！！！！！！！

1. Function abc(a, b)
   
2. Dim pp()
   
3. With CreateObject("vbscript.regexp")
   
4. .Global = True
   
5. .Pattern = "\d"
   
6. Set yy = .Execute(a)
   
7. For i = 1 To yy.Count
   
8. ReDim Preserve pp(0 To i - 1)
   
9. pp(i - 1) = yy.Item(i - 1) * 1
   
10. Next i
    
11. For i = 0 To UBound(pp)
    
12. If b = 1 Then
    
13. m = m & Application.Small(pp, i + 1)
    
14. Else
    
15. m = m & Application.Large(pp, i + 1)
    
16. End If
    
17. Next i
    
18. abc = m
    
19. End With
    
20. End Function
    

复制代码

这个意思？

cmjcmj8888

美斯特邦威 发表于 2013-10-7 15:34
这个意思？

好像不对啊?!!
编写一个excel自定义函数：输入一个数，将这个数的各数位重排后，得出最大值、最小值。
如：单元格A1输入2583，则B1输出最大值8532，C1输出最小值2358.

美斯特邦威

cmjcmj8888 发表于 2013-10-7 16:02
好像不对啊?!!
编写一个excel自定义函数：输入一个数，将这个数的各数位重排后，得出最大值、最小值。
...

难道不是？只是我附件B1是最小值，C1是最大值