有没有办法对单元格地址进行分类?

发布于 2025-02-11 00:26:37 字数 239 浏览 3 评论 0原文

有没有办法从左上角到右下方对单元格进行分类?

例如,

DIM targetAddress作为字符串

targetAddress =“ $ e $ 12,$ b $ 11:$ c $ 12,$ g $ 14,$ f $ 2,$ f9”'我想从左上到底部的随机选择的单元格,

所示:

如下 $ f $ 2,$ f $ 9,$ b $ 11:$ c $ 12,$ e $ 12,$ g $ 14”

Is there a way to sort cell addresses from top left to bottom right?

e.g.

Dim targetAddress As String

targetAddress = "$E$12,$B$11:$C$12,$G$14,$F$2,$F9" 'randomly selected cells

I want to sort targetAddress from top left to bottom right as follows:

"$F$2,$F$9,$B$11:$C$12,$E$12,$G$14"

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(3

jJeQQOZ5 2025-02-18 00:26:37

对工会的细胞地址进行排序,

我的第一个想法是工会是由Excel自动排序的,但事实证明我是错误的。在这里,使用用户“ Jorge-Ferreira”的QuickSort提案。

重读问题后,我发现以下是
解决方案不是被搜索的答案。 ; - (

Option Explicit

Sub sort_union()

    Dim myRange As Range
    Dim myCell As Range
    Dim myArray(100) As String
    Dim iCt As Integer
    Dim maxCt As Long
    
    Set myRange = Union(Range("$E$12"), Range("$B$11:$C$12"), Range("$G$14"), Range("$F$2"), Range("$F9"))
    
    Debug.Print myRange.Address
    
    iCt = 0
    Debug.Print vbCrLf & "ORIGINAL:"
    For Each myCell In myRange
        myArray(iCt) = myCell.Address
        Debug.Print iCt & " : " & myCell.Address & " =========> " & myArray(iCt)
        iCt = iCt + 1
    Next myCell
    maxCt = iCt - 1
    
    Call QuickSort(myArray, 0, maxCt)

    Set myRange = Nothing

    Debug.Print vbCrLf & "SORTED:"
    Set myRange = Range(myArray(0))
    Debug.Print 0, myArray(0)
    For iCt = 1 To maxCt
        Set myRange = Union(myRange, Range(myArray(iCt)))
        Debug.Print iCt, myArray(iCt)
    Next iCt

    Debug.Print vbCrLf & myRange.Address
End Sub

'using quicksort from
'https://stackoverflow.com/questions/152319/vba-array-sort-function

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

在此窗口的输出:

$E$12,$B$11:$C$12,$G$14,$F$2,$F$9

ORIGINAL:
0 : $E$12 =========> $E$12
1 : $B$11 =========> $B$11
2 : $C$11 =========> $C$11
3 : $B$12 =========> $B$12
4 : $C$12 =========> $C$12
5 : $G$14 =========> $G$14
6 : $F$2 =========> $F$2
7 : $F$9 =========> $F$9

SORTED:
 0            $B$11
 1            $B$12
 2            $C$11
 3            $C$12
 4            $E$12
 5            $F$2
 6            $F$9
 7            $G$14

$B$11:$C$12,$E$12,$F$2,$F$9,$G$14

Sorting the cell addresses of a union

My first thought was that a union is automatically sorted by Excel, but I was proven wrong. Here a proposal using Quicksort from user "jorge-ferreira".

After rereading the question I found that the below
solution is NOT the answer which was searched for. ;-(

Option Explicit

Sub sort_union()

    Dim myRange As Range
    Dim myCell As Range
    Dim myArray(100) As String
    Dim iCt As Integer
    Dim maxCt As Long
    
    Set myRange = Union(Range("$E$12"), Range("$B$11:$C$12"), Range("$G$14"), Range("$F$2"), Range("$F9"))
    
    Debug.Print myRange.Address
    
    iCt = 0
    Debug.Print vbCrLf & "ORIGINAL:"
    For Each myCell In myRange
        myArray(iCt) = myCell.Address
        Debug.Print iCt & " : " & myCell.Address & " =========> " & myArray(iCt)
        iCt = iCt + 1
    Next myCell
    maxCt = iCt - 1
    
    Call QuickSort(myArray, 0, maxCt)

    Set myRange = Nothing

    Debug.Print vbCrLf & "SORTED:"
    Set myRange = Range(myArray(0))
    Debug.Print 0, myArray(0)
    For iCt = 1 To maxCt
        Set myRange = Union(myRange, Range(myArray(iCt)))
        Debug.Print iCt, myArray(iCt)
    Next iCt

    Debug.Print vbCrLf & myRange.Address
End Sub

'using quicksort from
'https://stackoverflow.com/questions/152319/vba-array-sort-function

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

Here the output of the Immediate Window:

$E$12,$B$11:$C$12,$G$14,$F$2,$F$9

ORIGINAL:
0 : $E$12 =========> $E$12
1 : $B$11 =========> $B$11
2 : $C$11 =========> $C$11
3 : $B$12 =========> $B$12
4 : $C$12 =========> $C$12
5 : $G$14 =========> $G$14
6 : $F$2 =========> $F$2
7 : $F$9 =========> $F$9

SORTED:
 0            $B$11
 1            $B$12
 2            $C$11
 3            $C$12
 4            $E$12
 5            $F$2
 6            $F$9
 7            $G$14

$B$11:$C$12,$E$12,$F$2,$F$9,$G$14
蓝眸 2025-02-18 00:26:37

与与
上升的排和降列

最终要答案! ;-)

Option Explicit

Sub Split_and_Sort()

    Dim myRangeStr As String
    Dim myRangeArr() As String
    Dim myRange As Range
    Dim iCt As Integer
    Dim maxCt As Integer
    
    myRangeStr = "$E$12,$B$11:$C$12,$G$14,$F$2,$F9"
    myRangeArr = Split(myRangeStr, ",")
    
    Debug.Print vbCrLf & "ORIGINAL:"
    Debug.Print myRangeStr & vbCrLf
    
    iCt = 1
    Range("A1") = "Address"
    Range("B1") = "Row"
    Range("C1") = "Column"
    
    For iCt = 0 To UBound(myRangeArr)
        If myRangeArr(iCt) <> "" Then
            'Debug.Print iCt; " "; myRangeArr(iCt)
            maxCt = iCt + 1
            
            Range("A1").Offset(iCt + 1, 0) = myRangeArr(iCt)
            Range("B1").Offset(iCt + 1, 0) = Range(myRangeArr(iCt)).Row
            Range("C1").Offset(iCt + 1, 0) = Range(myRangeArr(iCt)).Column
        End If
    Next iCt

    Call SortCurrentRegion
    
    Set myRange = Range(Range("A2").Value)
    'iCt = 1: Debug.Print: Debug.Print iCt; myRange.Address
    
    'create sorted union
    For iCt = 2 To maxCt
        Set myRange = Union(myRange, Range(Range("A1").Offset(iCt, 0)))
        Debug.Print iCt; myRange.Address
    Next iCt
    
    Debug.Print vbCrLf & "SORTED:"
    Debug.Print myRange.Address

End Sub

Sub SortCurrentRegion()
    Dim sortRange As Range
    Set sortRange = ActiveSheet.Range("A1").CurrentRegion
    
    With ActiveSheet.Sort
        .SortFields.Clear
        
        'sort "Col B" = "Row" ascending
        .SortFields.Add2 Key:=Range("B1"), SortOn:=xlSortOnValues, _
            Order:=xlAscending, DataOption:=xlSortNormal
    
        'sort "Col C" = "Column" descending
        .SortFields.Add2 Key:=Range("C1"), SortOn:=xlSortOnValues, _
            Order:=xlDescending, DataOption:=xlSortNormal
    
        .SetRange Range("A1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

在这里,即时窗口的输出:

ORIGINAL:
$E$12,$B$11:$C$12,$G$14,$F$2,$F9

SORTED:
$F$2,$F$9,$B$11:$C$12,$E$12,$G$14

Sorting the cell addresses of a union with
ascending row and descending column

Finally the answer which was asked for! ;-)

Option Explicit

Sub Split_and_Sort()

    Dim myRangeStr As String
    Dim myRangeArr() As String
    Dim myRange As Range
    Dim iCt As Integer
    Dim maxCt As Integer
    
    myRangeStr = "$E$12,$B$11:$C$12,$G$14,$F$2,$F9"
    myRangeArr = Split(myRangeStr, ",")
    
    Debug.Print vbCrLf & "ORIGINAL:"
    Debug.Print myRangeStr & vbCrLf
    
    iCt = 1
    Range("A1") = "Address"
    Range("B1") = "Row"
    Range("C1") = "Column"
    
    For iCt = 0 To UBound(myRangeArr)
        If myRangeArr(iCt) <> "" Then
            'Debug.Print iCt; " "; myRangeArr(iCt)
            maxCt = iCt + 1
            
            Range("A1").Offset(iCt + 1, 0) = myRangeArr(iCt)
            Range("B1").Offset(iCt + 1, 0) = Range(myRangeArr(iCt)).Row
            Range("C1").Offset(iCt + 1, 0) = Range(myRangeArr(iCt)).Column
        End If
    Next iCt

    Call SortCurrentRegion
    
    Set myRange = Range(Range("A2").Value)
    'iCt = 1: Debug.Print: Debug.Print iCt; myRange.Address
    
    'create sorted union
    For iCt = 2 To maxCt
        Set myRange = Union(myRange, Range(Range("A1").Offset(iCt, 0)))
        Debug.Print iCt; myRange.Address
    Next iCt
    
    Debug.Print vbCrLf & "SORTED:"
    Debug.Print myRange.Address

End Sub

Sub SortCurrentRegion()
    Dim sortRange As Range
    Set sortRange = ActiveSheet.Range("A1").CurrentRegion
    
    With ActiveSheet.Sort
        .SortFields.Clear
        
        'sort "Col B" = "Row" ascending
        .SortFields.Add2 Key:=Range("B1"), SortOn:=xlSortOnValues, _
            Order:=xlAscending, DataOption:=xlSortNormal
    
        'sort "Col C" = "Column" descending
        .SortFields.Add2 Key:=Range("C1"), SortOn:=xlSortOnValues, _
            Order:=xlDescending, DataOption:=xlSortNormal
    
        .SetRange Range("A1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Here the output of the Immediate Window:

ORIGINAL:
$E$12,$B$11:$C$12,$G$14,$F$2,$F9

SORTED:
$F$2,$F$9,$B$11:$C$12,$E$12,$G$14
萌吟 2025-02-18 00:26:37

与与
升级和下降列

使用内置的Excel直接向前

Option Explicit

Sub sort_union()
    Dim myRange As Range
    Dim myCell As Range
    Dim iCt As Integer
    Dim maxCt As Integer
    
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("RangeSort").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Worksheets.Add.Name = "RangeSort"
    
    Set myRange = Union(Range("$E$12"), Range("$B$11:$C$12"), _
        Range("$G$14"), Range("$F$2"), Range("$F9"))
    
    Debug.Print vbCrLf & "ORIGINAL:"
    Debug.Print myRange.Address
    
    iCt = 1
    Range("A1") = "Address"
    Range("B1") = "Row"
    Range("C1") = "Column"
    
    For Each myCell In myRange
        Range("A1").Offset(iCt, 0) = myCell.Address
        Range("B1").Offset(iCt, 0) = myCell.Row
        Range("C1").Offset(iCt, 0) = myCell.Column
        iCt = iCt + 1
    Next myCell
    maxCt = iCt - 1
    
    Call SortCurrentRegion
    
    Set myRange = Range(Range("A2").Value)
    'Debug.Print iCt; myRange.Address
    'create sorted union
    For iCt = 2 To maxCt
        Set myRange = Union(myRange, Range(Range("A1").Offset(iCt, 0)))
        Debug.Print iCt; myRange.Address
    Next iCt
    
    Debug.Print vbCrLf & "SORTED:"
    Debug.Print myRange.Address


    'Delete Sheet "RangeSort"
    'On Error Resume Next
    'Application.DisplayAlerts = False
    'Sheets("RangeSort").Delete
    'Application.DisplayAlerts = True
    'On Error GoTo 0
    
End Sub


Sub SortCurrentRegion()
    Dim sortRange As Range
    Set sortRange = ActiveSheet.Range("A1").CurrentRegion
    
    With ActiveSheet.Sort
        .SortFields.Clear
        
        'sort "Col B" = "Row" ascending
        .SortFields.Add2 Key:=Range("B1"), SortOn:=xlSortOnValues, _
            Order:=xlAscending, DataOption:=xlSortNormal
    
        'sort "Col C" = "Column" descending
        .SortFields.Add2 Key:=Range("C1"), SortOn:=xlSortOnValues, _
            Order:=xlDescending, DataOption:=xlSortNormal
    
        .SetRange Range("A1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

:在此处的输出:

ORIGINAL:
$E$12,$B$11:$C$12,$G$14,$F$2,$F$9

SORTED:
$F$2,$F$9,$E$12,$B$11:$C$12,$G$14

为什么$ e $ $ $ $ $ 12 $ b $ 11:$ c $ 12?

在即时窗口的输出中,我们看到,通过向工会添加地址$ 11 $ C $ 11:$ b $ 11:$ c $ 12的$ 12更改为工会结束! ;-(

ORIGINAL:
$E$12,$B$11:$C$12,$G$14,$F$2,$F$9

 2 $F$2,$F$9
 3 $F$2,$F$9,$C$11
 4 $F$2,$F$9,$B$11:$C$11
 5 $F$2,$F$9,$B$11:$C$11,$E$12
 6 $F$2,$F$9,$B$11:$C$11,$E$12,$C$12
 7 $F$2,$F$9,$E$12,$B$11:$C$12            
 ^^-- $C$11 is added to the union here
 8 $F$2,$F$9,$E$12,$B$11:$C$12,$G$14
 ^^-- $B$11:$C$12 moved to the end of the union automatically

SORTED:
$F$2,$F$9,$E$12,$B$11:$C$12,$G$14

Sorting the cell addresses of a union with
ascending row and descending column

Straight forward approach using the inbuilt sort of Excel:

Option Explicit

Sub sort_union()
    Dim myRange As Range
    Dim myCell As Range
    Dim iCt As Integer
    Dim maxCt As Integer
    
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("RangeSort").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Worksheets.Add.Name = "RangeSort"
    
    Set myRange = Union(Range("$E$12"), Range("$B$11:$C$12"), _
        Range("$G$14"), Range("$F$2"), Range("$F9"))
    
    Debug.Print vbCrLf & "ORIGINAL:"
    Debug.Print myRange.Address
    
    iCt = 1
    Range("A1") = "Address"
    Range("B1") = "Row"
    Range("C1") = "Column"
    
    For Each myCell In myRange
        Range("A1").Offset(iCt, 0) = myCell.Address
        Range("B1").Offset(iCt, 0) = myCell.Row
        Range("C1").Offset(iCt, 0) = myCell.Column
        iCt = iCt + 1
    Next myCell
    maxCt = iCt - 1
    
    Call SortCurrentRegion
    
    Set myRange = Range(Range("A2").Value)
    'Debug.Print iCt; myRange.Address
    'create sorted union
    For iCt = 2 To maxCt
        Set myRange = Union(myRange, Range(Range("A1").Offset(iCt, 0)))
        Debug.Print iCt; myRange.Address
    Next iCt
    
    Debug.Print vbCrLf & "SORTED:"
    Debug.Print myRange.Address


    'Delete Sheet "RangeSort"
    'On Error Resume Next
    'Application.DisplayAlerts = False
    'Sheets("RangeSort").Delete
    'Application.DisplayAlerts = True
    'On Error GoTo 0
    
End Sub


Sub SortCurrentRegion()
    Dim sortRange As Range
    Set sortRange = ActiveSheet.Range("A1").CurrentRegion
    
    With ActiveSheet.Sort
        .SortFields.Clear
        
        'sort "Col B" = "Row" ascending
        .SortFields.Add2 Key:=Range("B1"), SortOn:=xlSortOnValues, _
            Order:=xlAscending, DataOption:=xlSortNormal
    
        'sort "Col C" = "Column" descending
        .SortFields.Add2 Key:=Range("C1"), SortOn:=xlSortOnValues, _
            Order:=xlDescending, DataOption:=xlSortNormal
    
        .SetRange Range("A1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Here the output of the Immediate Window:

ORIGINAL:
$E$12,$B$11:$C$12,$G$14,$F$2,$F$9

SORTED:
$F$2,$F$9,$E$12,$B$11:$C$12,$G$14

Why is $E$12 in front of $B$11:$C$12?
In the output of the Immediate Window we see that by adding address $C$11 to the union the range $B$11:$C$12 changes to the end of the union! ;-(

ORIGINAL:
$E$12,$B$11:$C$12,$G$14,$F$2,$F$9

 2 $F$2,$F$9
 3 $F$2,$F$9,$C$11
 4 $F$2,$F$9,$B$11:$C$11
 5 $F$2,$F$9,$B$11:$C$11,$E$12
 6 $F$2,$F$9,$B$11:$C$11,$E$12,$C$12
 7 $F$2,$F$9,$E$12,$B$11:$C$12            
 ^^-- $C$11 is added to the union here
 8 $F$2,$F$9,$E$12,$B$11:$C$12,$G$14
 ^^-- $B$11:$C$12 moved to the end of the union automatically

SORTED:
$F$2,$F$9,$E$12,$B$11:$C$12,$G$14
~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文