以下代码行将数组分配为一维sortedArr = WorksheetFunction.Transpose(lstIssues1.List)
。这行代码将数组分配为二维arrIssues = Table.ListColumns(Table.ListColumns(strNumber).Range.column).DataBodyRange
对于上面的每一行,我称之为冒泡排序功能。但是它在一个或另一个上的错误取决于我是否放
If Arr(i) > Arr(j) Then ...
或者
If Arr(i, 1) > Arr(j, 1) Then ...
我可以循环填充arrIssues
。但我想知道是否有可能将其填充为一维数组而不进行循环。
更新
以下是我遇到问题的代码
Private Sub cmdRemove_Click()
Dim SortedArr() As Variant
With lstPrevious
If .ListIndex = -1 Then Exit Sub
For i = .ListCount - 1 To 0 Step -1
If .Selected(i) = True Then
lstAdditional.AddItem .List(i)
.RemoveItem (i)
End If
Next i
End With
ReDim SortedArr(lstAdditional.ListCount - 1)
SortedArr = Application.Transpose(lstAdditional.List) 'ERROR Type Mismatch
Call BubbleSort(SortedArr)
Me.lstAdditional.List = SortedArr
txtFocus.SetFocus
End Sub
Public Sub BubbleSort(Arr)
Dim strTemp As String
Dim lngMin As Long
Dim lngMax As Long
lngMin = LBound(Arr)
lngMax = UBound(Arr)
For i = lngMin To lngMax
For j = i + 1 To lngMax
If Arr(i) > Arr(j) Then
strTemp = Arr(i)
Arr(i) = Arr(j)
Arr(j) = strTemp
End If
Next j
Next i
End Sub
奇怪的是,我在另一个用户表单中使用相同的逻辑,它可以工作。抱歉缺乏清晰度。
答案 0 :(得分:0)
对于上面的每一行,我称之为冒泡排序功能。但它在一个或另一个上的错误取决于我是否把If Arr(i)> Arr(j)然后......或者如果Arr(i,1)> Arr(j,1)然后......
i
,j
的值不正确,因此出错。我猜你得到了Subscript out of range error
。
这是一种重现错误的简单方法。
Sub Sample()
Dim i As Long, j As Long, k As Integer
Dim MyAr As Variant
MyAr = Range("A1:A5").Value
For i = LBound(MyAr) To UBound(MyAr)
For j = LBound(MyAr) To UBound(MyAr)
If MyAr(j, 1) > MyAr(j + 1, 1) Then
k = MyAr(j, 1)
MyAr(j, 1) = MyAr(j + 1, 1)
MyAr(j + 1, 1) = k
End If
Next
Next
End Sub
正确的方法是循环到UBound(MyAr) - 1
Sub Sample()
Dim i As Long, j As Long, k As Integer
Dim MyAr As Variant
MyAr = Range("A1:A5").Value
For i = LBound(MyAr) To (UBound(MyAr) - 1)
For j = LBound(MyAr) To (UBound(MyAr) - 1)
If MyAr(j, 1) > MyAr(j + 1, 1) Then
k = MyAr(j, 1)
MyAr(j, 1) = MyAr(j + 1, 1)
MyAr(j + 1, 1) = k
End If
Next
Next
End Sub