6

コンボボックスの値を並べ替える方法を考えていました。

シート上の値の数は絶えず増加しているため、フォームを初期化するときにComboBoxに項目を追加します。

次のコードを使用してアイテムを追加します。

With ComboBox1
lastcell = ThisWorkbook.Sheets("1").Range("F1000000").End(xlUp).Row + 1
For i = 2 To lastcell 
.AddItem ThisWorkbook.Sheets("1").Cells(i, 6)
Next i
End With

ComoBoxに追加する値を別のシートにコピーして、新しいシートに並べ替えようと思いました。正常に機能しますが、賢いオプションではないようです。つまり、別のシートを作成してから作成します。値を直接並べ替えるのではなく、値をコピーして並べ替えます。

私の質問は、誰もが元のシートから直接それを行う方法を知っていますか？APIについては何も知らないので、VBAコードのみをお願いします。私はすでにMSDNをチェックしていますが、それを機能させる方法がわかりません。

ありがとうございます。さらに情報が必要な場合は、お知らせください。

PS：このシートは静的な順序である必要があるため、元のシートから直接並べ替えることはできません

4

4 に答える 4

3

シートから値を読み取って配列に入れ、これをコードで並べ替えてから、項目を追加できます。

このコードは、クイックソートを使用してこれを行います。

Private Sub UserForm_Initialize()
    Dim varRange() As Variant
    Dim lngLastRow As Long
    Dim i As Long

    lngLastRow = Range("F:F").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    varRange = Range("F:F").Resize(lngLastRow).Cells

    subQuickSort varRange

    Me.ComboBox1.List = varRange
End Sub


Public Sub subQuickSort(var1 As Variant, _
    Optional ByVal lngLowStart As Long = -1, _
    Optional ByVal lngHighStart As Long = -1)

    Dim varPivot As Variant
    Dim lngLow As Long
    Dim lngHigh As Long

    lngLowStart = IIf(lngLowStart = -1, LBound(var1), lngLowStart)
    lngHighStart = IIf(lngHighStart = -1, UBound(var1), lngHighStart)
    lngLow = lngLowStart
    lngHigh = lngHighStart

    varPivot = var1((lngLowStart + lngHighStart) \ 2, 1)

    While (lngLow <= lngHigh)
        While (var1(lngLow, 1) < varPivot And lngLow < lngHighStart)
            lngLow = lngLow + 1
        Wend

        While (varPivot < var1(lngHigh, 1) And lngHigh > lngLowStart)
            lngHigh = lngHigh - 1
        Wend

        If (lngLow <= lngHigh) Then
            subSwap var1, lngLow, lngHigh
            lngLow = lngLow + 1
            lngHigh = lngHigh - 1
        End If
    Wend

    If (lngLowStart < lngHigh) Then
        subQuickSort var1, lngLowStart, lngHigh
    End If
    If (lngLow < lngHighStart) Then
        subQuickSort var1, lngLow, lngHighStart
    End If

End Sub

Private Sub subSwap(var As Variant, lngItem1 As Long, lngItem2 As Long)
    Dim varTemp As Variant
    varTemp = var(lngItem1, 1)
    var(lngItem1, 1) = var(lngItem2, 1)
    var(lngItem2, 1) = varTemp
End Sub
于 2013-03-21T09:41:18.490 に答える
1

状況、データの種類、構造によって異なります。しかし、私はそれをこのようにすることを好みます：
代わりに配列とバブルソートアルゴリズムを使用することができます:)
あなたのケースに合うようにコードを少し変更してください 

Option Explicit

Sub WITH_COMBOBOX()

    Dim i As Long
    Dim arr() As String

    Dim lastCell As Long
    lastCell = 500

    ReDim arr(lastCell)
    Call FillAndSortArray(arr)

    For i = 2 To lastCell
        .AddItem arr(i - 2)
    Next i
End Sub

Sub FillAndSortArray(ByRef myArray() As String)

    Dim i As Long

    For i = LBound(myArray) To UBound(myArray)
        myArray(i) = CStr(ThisWorkbook.Sheets(1).Range("F" & i + 2).Value)
    Next i

    Call BubbleSort(myArray)
End Sub


Sub BubbleSort(ByRef myArray() As String)

    Dim i As Long, j As Long
    Dim Temp As String

    For i = LBound(myArray) To UBound(myArray) - 1
        For j = i + 1 To UBound(myArray) - 1
            If myArray(i) > myArray(j) Then
                Temp = myArray(j)
                myArray(j) = myArray(i)
                myArray(i) = Temp
            End If
        Next j
    Next i
End Sub
于 2013-03-21T09:36:34.683 に答える
0

以下のコードを試してください：

Sub GetAction()

    Dim rng As Range, lastcell As Long
    lastcell = Range("F1000").End(xlUp).Row + 1
    Set rng = Range("F1:F" & lastcell)  ' assuming to start from F1

    If Not rng Is Nothing Then
        rng.Sort Range("F1")
        ComboBox1.ListFillRange = rng.Address
    End If

End Sub
于 2013-03-21T09:25:36.167 に答える
0

番号の123をソートするため

For Each cell In ThisWorkbook.Sheets("sheet1").Range("list1")

Me.ComboBox1.AddItem cell

Next cell

With Me.ComboBox1

 For x = LBound(.list) To UBound(.list)

   For y = x To UBound(.list)

   If .list(y, 0) + 0 < .list(x, 0) + 0 Then

     blah = .list(y, 0)

    .list(y, 0) = .list(x, 0)

    .list(x, 0) = blah

   End If

 Next y

Next x

 End With

テキストabcdをソートするため

For Each cell In ThisWorkbook.Sheets("sheet1").Range("list1")

Me.ComboBox1.AddItem cell

Next cell

With Me.ComboBox1

 For x = LBound(.list) To UBound(.list)

   For y = x To UBound(.list)

   If .list(y, 0)  < .list(x, 0)  Then

     blah = .list(y, 0)

    .list(y, 0) = .list(x, 0)

    .list(x, 0) = blah

   End If

 Next y

Next x

 End With
于 2017-10-12T15:39:00.050 に答える