Question

是否有一种简单的方法可以让代码执行选择，而不仅仅是活动单元格？我的大脑被炸了，我无法做到这一点......我需要能够做大约10,000行。

Option Explicit

Public Sub SortVals()
    Dim i As Integer
    Dim arr As Variant
    arr = Split(ActiveCell.Text, ",")

    ' trim values so sort will work properly
    For i = LBound(arr) To UBound(arr)
        arr(i) = Trim(arr(i))
    Next i

    ' sort
    QuickSort arr, LBound(arr), UBound(arr)

    ' load sorted values back to cell
    Dim comma As String
    comma = ""
    ActiveCell = ""
    For i = LBound(arr) To UBound(arr)
        ActiveCell = ActiveCell & comma & CStr(arr(i))
        comma = ","
    Next i
End Sub

Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)

  Dim pivot   As Variant
  Dim tmpSwap As Variant
  Dim tmpLow  As Long
  Dim tmpHi   As Long

  tmpLow = inLow
  tmpHi = inHi

  pivot = vArray((inLow + inHi) \ 2)

  While (tmpLow <= tmpHi)

     While (vArray(tmpLow) < pivot And tmpLow < inHi)
        tmpLow = tmpLow + 1
     Wend

     While (pivot < vArray(tmpHi) And tmpHi > inLow)
        tmpHi = tmpHi - 1
     Wend

     If (tmpLow <= tmpHi) Then
        tmpSwap = vArray(tmpLow)
        vArray(tmpLow) = vArray(tmpHi)
        vArray(tmpHi) = tmpSwap
        tmpLow = tmpLow + 1
        tmpHi = tmpHi - 1
     End If

  Wend

  If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
  If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi

End Sub

Answer 1

尝试这样的事情。我更新宏以获得循环。

使用以下示例

Before
threat,concert,pin
saw,bench,danger,tongue,straw
republic,stars,pie,sermon,tongue,prize,puppet
prison,lollipop
crown,bench,clown,price,apple pie,ankle,laser

我运行以下内容。注意我正在省略QuickSort，因为它没有被编辑。

Option Explicit

Public Sub SortValsSelection()
    Dim rngSelection As Range
    Dim rngSingleCell As Range
    Set rngSelection = Selection

    For Each rngSingleCell In rngSelection.Cells
        Call SortVals(rngSingleCell)
    Next
End Sub

Public Sub SortVals(rngRange As Range)
    Dim i As Integer
    Dim arr As Variant
    Dim strSorted As String
    arr = Split(rngRange.Text, ",")

    ' trim values so sort will work properly
    For i = LBound(arr) To UBound(arr)
        arr(i) = Trim(arr(i))
    Next i

    ' sort
    QuickSort arr, LBound(arr), UBound(arr)

    ' load sorted values back to cell
    Dim comma As String
    comma = ""
    strSorted = ""
    For i = LBound(arr) To UBound(arr)
        strSorted = strSorted & comma & CStr(arr(i))
        comma = ","
    Next i

    rngRange.Value = strSorted
End Sub

我删除了对活动单元格的引用，并将其替换为参数rngRange，后者是您选择的单个单元格。选择所有单元格后输出以下内容

concert,pin,threat
bench,danger,saw,straw,tongue
pie,prize,puppet,republic,sermon,stars,tongue
lollipop,prison
ankle,apple pie,bench,clown,crown,laser,price

在选择中使用QuickSort / SortVals VB脚本，而不仅仅是活动单元格

1 个答案: