尝试按字符串表编号排序

Question

我尝试按文档标识符的升序(按BMC-9、CSR-9、MC-9，然后是LC-9)对列表进行排序，然后按页码排序，顺序如下图所示。我知道代码按我想要的顺序放置文档标识符，但我的工作表编号不是我想要的顺序。

我已经尝试用宏记录我想要的顺序。我还在这里发布了我现有的代码。

    Option Explicit
Sub CableWiringSort()
    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 J As Range

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

Dim strSearch As String

Call findlc

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, 10).Resize(UBound(vRes1, 1), 2)
With Application
    .ScreenUpdating = False
With r
    .Columns(1).Value = vRes1
    .Columns(2).Value = vRes2
    .EntireColumn.HorizontalAlignment = xlCenter
End With

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

Call findlc
Call Last

With Sheets("TELECOM").Range("A14:F305")
            With .Font
                .Name = "Arial"
                .FontStyle = "Regular"
                .Size = 9
            End With
            End With


End Sub

​

​

我想带来图纸2作为绘图系列的一部分，上面的F1和下面的A4 (如图所示)我希望顺序是数字，然后是字母。因此，LC-900785以上的所有数据都是正确的。LC-900785的订单应为：

LC-900785   2
LC-900785   F1
LC-900785   F2
LC-900785   F4
LC-900785   L1
LC-900785   Z1
LC-900785   Z2

Answer 1

这就是解决方案，我真的对它进行了测试，它100%有效，即使是空白行，我也希望能帮助你。

​

​

子BtnOrdertwoCell_Click()

在出错时恢复下一步

Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Dim sht作为工作表

Dim LastRow As Long

设置sht = ActiveSheet

作为整数的Dim ColRowsCount

ColRowsCount = sht.Range("A1").CurrentRegion.Rows.Count

Range("A2:A“& ColRowsCount，"B2:B”& ColRowsCount).Sort Key1:=Range("A2"，"B2")，Order1:=xlAscending，Header:=xlNo

结束子对象