求数最大值及type end type的排序方法。

Question

此程序是http://topic.csdn.net/u/20080922/14/c3cbbd55-9e42-4716-bedd-fcfdbd9818c7.html
Private Type MType 
    value As Variant 
    locate As Integer 
End Type Private Sub Form_Load() 
    Dim a(7) As Integer 
    a(0) = 1 
    a(1) = 8 
    a(2) = 1 
    a(3) = 8 
    a(4) = 4 
    a(5) = 3 
    a(6) = 9 
    a(7) = 1 
    
    Dim m As MType 
    m = MaxValue(a) 
    MsgBox "最大值是：" & m.value & "    位置是：" & m.locate 
End Sub Private Function MaxValue(ByVal arr As Variant) As MType 
    Dim i As Integer 
    Dim max As MType 
    max.value = arr(LBound(arr)) 
    max.locate = LBound(arr) 
    
    For i = LBound(arr) To UBound(arr) 
        If arr(i) > max.value Then 
            max.value = arr(i) 
            max.locate = i 
        End If 
    Next 
    MaxValue = max 
End Function根据这个程序改了一下最大值是：" & m.value & "    位置是：" & m.locate temp = arr(0)   '将arr(0)的数据赋值给temp
arr(0)= arr(max.locate) 将max.locate位置的数据赋值给 arr(0) 
arr(max.locate)= temp 再将原arr(0)赋给arr(max.locate)请问,各位大侠有何高招.
再请问各位大侠,type ... end type的排序方法.谢谢.

Answer 1

Private Sub Form_Load() 
    Dim a(7) As Integer 
    a(0) = 1 
    a(1) = 8 
    a(2) = 1 
    a(3) = 8 
    a(4) = 4 
    a(5) = 3 
    a(6) = 9 
    a(7) = 1 
    
    Dim m As integer 
    m = MaxValue(a) 
    MsgBox "最大值是：" & a(m) & "    位置是：" & m
End Sub Private Function MaxValue(ByVal arr As Variant) As integer 
    Dim i As Integer 
    Dim max As MType
    max.value = arr(LBound(arr)) 
    max.locate = LBound(arr) 
    
    For i = LBound(arr) To UBound(arr) 
        If arr(i) > max Then 
            max.value = arr(i) 
            max.locate = i 
        End If 
    Next 
    MaxValue = max.locate 
End Function 

Answer 2

如果你不打算保留原来的索引值（就是你的 locate），和常规的数组排序没有什么不同，也用不着你的 Type.如果 locate 是需要保留的有效数据，另外建一个数据，将排序后的 Index 保存进去。

Answer 3

如果让我来完整这样的功能，我会义无反顾的使用类+Collection 对象而不是数组。 数组快是快，但是多个属性的时候collection提供的New，Remove，Item，Count等太好用了。

Answer 4

'模块
Public a1 As Variant, a2 As Variant
Function Bubble_Sort(Ary, Bry) '降序排列
  Dim aryUBound, i, j
  aryUBound = UBound(Ary)
  For ii = 0 To aryUBound
    Ary(ii) = Val(Round(Ary(ii), 2))
  Next ii
  For i = 0 To aryUBound
    For j = i + 1 To aryUBound
      If Ary(i) < Ary(j) Then
        Swap Ary(i), Ary(j)
        Swap Bry(i), Bry(j)
      End If
    Next
  Next
  a1 = Ary
  a2 = Bry
End FunctionFunction Bubble1_Sort(Ary, Bry) '升序排列
  Dim aryUBound, i, j
  aryUBound = UBound(Ary)
  For ii = 0 To aryUBound
    Ary(ii) = Val(Round(Ary(ii), 2))
  Next ii
  For i = 0 To aryUBound
    For j = i + 1 To aryUBound
      If Ary(i) > Ary(j) Then
        Swap Ary(i), Ary(j)
        Swap Bry(i), Bry(j)
      End If
    Next
  Next
  a1 = Ary
  a2 = Bry
 
End Function
Private Function Swap(a, b)
  Dim tmp
  tmp = a
  a = b
  b = tmp
End Function
'窗体
Private Type MType
    value As Variant
    locate As Variant
End Type
Dim a As MTypePrivate Sub Command1_Click() '升序排列
a.value = Array(1, 8, 1, 8, 4, 3, 9, 1)
a.locate = Array(1, 2, 3, 4, 5, 6, 7, 8)
Bubble1_Sort a.value, a.locate
For i = 0 To UBound(a1)
List1.AddItem a1(i)
Next
For i = 0 To UBound(a1)
List2.AddItem a2(i) '排序后原位置的变化
Next
End SubPrivate Sub Command2_Click() '降序排列
a.value = Array(1, 8, 1, 8, 4, 3, 9, 1)
a.locate = Array(1, 2, 3, 4, 5, 6, 7, 8)
Bubble_Sort a.value, a.locate
For i = 0 To UBound(a1)
List1.AddItem a1(i)
Next
For i = 0 To UBound(a1)
List2.AddItem a2(i) '排序后原位置的变化
Next
End Sub

Answer 5

谢谢楼上各位大侠的回复.
发此帖的目的是看了http://topic.csdn.net/u/20080922/14/c3cbbd55-9e42-4716-bedd-fcfdbd9818c7.html 
这个帖子求数组的最大值,用了type ... end type方法.
想将此方法,扩展应用一下。由于概念模糊,标题表述不清,让各位大侠费心了.
谢谢SYYZ(老张)的指点,此帖应定义为《多主题排序》，更为贴切。 

Answer 6

两个按钮最前面加
List1.Clear
List2.Clear
加第三个按钮,恢复原样,代码为
Private Sub Command3_Click() '恢复原样
List1.Clear
List2.Clear
a.value = Array(1, 8, 1, 8, 4, 3, 9, 1)
a.locate = Array(1, 2, 3, 4, 5, 6, 7, 8)
Bubble1_Sort a.locate, a.value
For i = 0 To UBound(a1)
List1.AddItem a1(i)
Next
For i = 0 To UBound(a1)
List2.AddItem a2(i) '原样
Next
End Sub

Answer 7

看了半天好象没太看懂，你的type只是记录数组a中某一个元素的属性，type自身又不是数组，怎么排序？
如果说是数组a排序后，依然想保存a原有的下标，和type也没关系啊？

Answer 8

LZ就是希望数字,数字的位置都能排序,我的代码里
Private Type MType
    value As Variant
    locate As Variant
End Type
 value和locate都是数组
由于数字,数字的位置都能排序,而且对应关系一直存在,所以我把它叫做"多主题排序",其实,主题还可以增加到很多个.

Answer 9

哦，这样的话，可以直接声明一个mtype数组排序：Private Function GetSortType(a() As Integer, SortType() As MType, Optional pSort As String = "ASC") As Boolean
    
    Dim i As Long, j As Long
    Dim n As Long, m As Long
    Dim tmp As MType
    
    pSort = UCase(Trim(pSort))
    If pSort <> "ASC" And pSort <> "DESC" Then
        GetSortType = False
        Exit Function
    End If
    
    n = LBound(a)
    m = UBound(a)
    
    ReDim tmpType(n To m) As MType
    For i = n To m
        tmpType(i).Value = a(i)
        tmpType(i).Locate = i
    Next
    
    For i = n To m - 1
        For j = i + 1 To m
            If pSort = "ASC" Then
                If tmpType(i).Value > tmpType(j).Value Then
                    tmp = tmpType(i)
                    tmpType(i) = tmpType(j)
                    tmpType(j) = tmp
                End If
            Else
                If tmpType(i).Value < tmpType(j).Value Then
                    tmp = tmpType(i)
                    tmpType(i) = tmpType(j)
                    tmpType(j) = tmp
                End If
            End If
        Next
    Next    SortType = tmpType
    GetSortType = True
End FunctionPrivate Sub Command1_Click()
    
    Dim m() As MType
    Dim a(7) As Integer
    Dim i As Long
    
    a(0) = 1
    a(1) = 8
    a(2) = 1
    a(3) = 8
    a(4) = 4
    a(5) = 3
    a(6) = 9
    a(7) = 1
    
    If GetSortType(a, m) Then
        For i = 0 To 7
            Debug.Print m(i).Value; m(i).Locate
        Next
        Debug.Print
    End If
End Sub