填充一维数组而不循环

时间:2016-09-14 16:41:19

标签: arrays excel excel-vba vba

以下代码行将数组分配为一维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

奇怪的是,我在另一个用户表单中使用相同的逻辑,它可以工作。抱歉缺乏清晰度。

1 个答案:

答案 0 :(得分:0)

  

对于上面的每一行,我称之为冒泡排序功能。但它在一个或另一个上的错误取决于我是否把If Arr(i)> Arr(j)然后......或者如果Arr(i,1)> Arr(j,1)然后......

ij的值不正确,因此出错。我猜你得到了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