Question

我有一个列表，我想按字母数字排序。我目前有我的列表排序如下：

Column B    Column C    
LC-94774    102-A    
LC-94774    102-AA    
LC-94774    102-AF    
LC-94774    102-AG    
LC-94774    102-AP    
LC-94774    102-T    
LC-94774    104-M    
LC-94774    105-AA    
LC-94774    105-C    
LC-94774    105-L    
LC-94773    1    
LC-94773    2    
LC-94773    3    
LC-94773    2A

但是我试图将其归类为：

Column B        Column C    
LC-94774    102-A    
LC-94774    102-T    
LC-94774    102-AA    
LC-94774    102-AF    
LC-94774    102-AG    
LC-94774    102-AP    
LC-94774    104-M    
LC-94774    105-C    
LC-94774    105-L    
LC-94774    105-AA    
LC-94773    1    
LC-94773    2    
LC-94773    2A    
LC-94773    3

目前，我有以下书面代码：

Option Explicit
Sub telecomsorter()

Dim lastRow As Long
Dim First As Long
Dim Last As Long
Dim r As Long

With Worksheets("TELECOM")

lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
Range("B13:C" & lastRow).Select

ActiveWorkbook.Worksheets("TELECOM").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("TELECOM").Sort.SortFields.Add Key:=Range( _
        "B14:B" & lastRow & ""), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "BMC-*,CSR-*,MC-*,LC-*," & Chr(42) & "", DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("TELECOM").Sort.SortFields.Add2 Key:=Range( _
        "C14:C" & lastRow & ""), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal

  With ActiveSheet.Sort
      .SetRange Range("B14:C" & lastRow)
      .Header = xlNo
      .Orientation = xlTopToBottom
      .Apply
  End With

 Call SortSpecial("LC-*", xlDescending)
 Call SortSpecial("MC-*", xlAscending)
 Call SortSpecial("LC-*", xlAscending)
 Call SortSpecial("LC-*", xlDescending)
End With




End Sub

Public Function SortSpecial(ByVal StrVal As String, ByVal SortOrder As XlSortOrder)

  Dim First As Long
  Dim Last As Long

  First = Columns("B").Find(StrVal, , xlValues, , xlRows, xlNext, , , False).Row
  Last = Columns("B").Find(StrVal, , xlValues, , xlRows, xlPrevious, , , False).Row

  ActiveSheet.Sort.SortFields.Clear
  ActiveSheet.Sort.SortFields.Add Key:=Range("B" & First & ":B" & Last), SortOn:=xlSortOnValues, Order:=SortOrder, DataOption:=xlSortNormal

  With ActiveSheet.Sort

  If SortOrder = xlAscending Then
    .SetRange Range("B" & First & ":C" & Last)
  Else
  Last = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
  .SetRange Range("B" & First & ":C" & Last)
  End If

    .Header = xlNo
    .Orientation = xlTopToBottom
    .Apply

  End With

End Function

新编辑：不，只是我想先对B列进行排序，然后对C列进行以下排序：

LC-94774 102-A

LC-94774 102-B

LC-94774 102-AA

请注意，它的排序方式不像：（当前的排序方式）

LC-94774 102-A

LC-94774 102-AA

LC-94774 102-B

请注意如何将A放在最前面，然后是B放在后面。我希望它首先以字母顺序输入单个字母，然后是AA AB AC..etc（有点像MS在列中的设置方式）

NEW EDIT 04/09/2019：

Option Explicit
Sub sortAlphaNum()
    Dim ws As Worksheet, r As Range
    Dim wsSort As Worksheet
    Dim vSrc As Variant, vToSort As Variant
    Dim RE As Object, MC As Object
    Const sPat As String = "(\d+)-?(\D*)" 'note that some do not have a hyphen
    Dim I As Long, V As Variant
    Dim LCstartrow As Integer
    Dim LCendrow As Integer
    Dim J As Long

'input data to variant array
Set ws = Worksheets("TELECOM")

'Finding the row in which the first LC-* Drawing starts

Dim xRow As Integer
Dim strSearch As String

strSearch = "LC-*" 'Find the first
' Assuming Total is in column C as your picture shows, but you can configure to search anywhere

xRow = Range("C" & Rows.Count).End(xlUp).Row
Range("$C1:C" & xRow).Select

J = Selection.Find(What:=strSearch, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select

With ws
    vSrc = .Range(ActiveCell, .Cells(.Rows.Count, 2).End(xlUp)).Resize(columnsize:=2)
End With

'create array of ColB, and Col C split into Numeric, Alpha & len(alpha) for column c
'cannot split column 2 on the hyphen since not all requiring a split contain a hyphen.

ReDim vToSort(1 To UBound(vSrc, 1), 1 To 7)

Set RE = CreateObject("vbscript.regexp")
With RE
    .Global = False
    .ignorecase = False 'or could be true
    .Pattern = sPat
End With
For I = 1 To UBound(vSrc, 1)
    Set MC = RE.Execute(vSrc(I, 2))
        vToSort(I, 1) = vSrc(I, 1)
            V = Split(vSrc(I, 1), "-")
        vToSort(I, 2) = V(0)
        vToSort(I, 3) = V(1)
    Set MC = RE.Execute(vSrc(I, 2))
        vToSort(I, 4) = vSrc(I, 2)
        vToSort(I, 5) = MC(0).submatches(0)
        vToSort(I, 6) = MC(0).submatches(1)
        vToSort(I, 7) = Len(vToSort(I, 6))
Next I

'write to hidden sheet for sorting
Set wsSort = Worksheets.Add
With wsSort
    '.Visible = xlSheetHidden
    Set r = .Cells(1, 1).Resize(UBound(vToSort, 1), UBound(vToSort, 2))
    r.Value = vToSort
End With

'sort on the hidden sheet
wsSort.Sort.SortFields.Clear
    wsSort.Sort.SortFields.Add2 Key:=r.Columns(2) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="BMC,CSR,MC,LC" _
        , DataOption:=xlSortNormal
    wsSort.Sort.SortFields.Add2 Key:=r.Columns(3) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    wsSort.Sort.SortFields.Add2 Key:=r.Columns(5) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    wsSort.Sort.SortFields.Add2 Key:=r.Columns(7) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    wsSort.Sort.SortFields.Add2 Key:=r.Columns(6) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With wsSort.Sort
        .SetRange r
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'create results array with the needed columns
Dim vRes1 As Variant, vRes2 As Variant

Set r = Union(r.Columns(1), r.Columns(4))

vRes1 = r.Areas(1)
vRes2 = r.Areas(2)
'write back to the original sheet
'but offset for now for trouble shooting

Set r = Worksheets("Telecom").Cells(1, 8).Resize(UBound(vRes1, 1), 2)
With Application
    .ScreenUpdating = False
With r

    .Columns(1).Value = vRes1
    .Columns(2).Value = vRes2
    .EntireColumn.HorizontalAlignment = xlCenter
    .EntireColumn.AutoFit
End With

'delete the hidden sheet
    .DisplayAlerts = False
        'wsSort.Delete
    .DisplayAlerts = True
    .ScreenUpdating = True
End With

End Sub

Answer 1

您似乎要排序

B列：以自定义顺序升序到字符串的第一部分
B列：字符串第二部分（数字）的降序
C列：数字部分升序
C列：按字母顺序升序
C列：升序为字符串的alpha部分

对于B列，两个部分可以在连字符上分开对于C列，由于不总是使用连字符，因此我使用正则表达式来拆分字母和数字部分，但可以使用其他方法。

使用的方法是将数据分为多列，并根据需要对每列进行排序。这种排序是在一次性工作表上完成的，然后将结果复制回原始工作表。

对于该代码，出于调试目的，我将结果与原始结果相抵消，因为可能存在一些您未提供信息的配置。但这确实会在您的测试数据上产生预期的结果。

having min(substr(t.colB, 1, 1)) = max(substr(t.colB, 1, 1))

如何按字母顺序和长度排序列表

1 个答案: