Попытка сортировки по номеру строки

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%, и даже с пустыми строками, я надеюсь, поможет вам.

SubBtnOrdertwoCell_Click ()

При ошибке Возобновить Далее

Столбцы ("A"). SpecialCells (xlCellTypeBlanks) .EntireRow.Delete

Dim sht As Worksheet

Dim LastRow As Long

Установить sht = ActiveSheet

Dim ColRowsCount в виде целого числа

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

Range («A2: A» и ColRowsCount, «B2: B» и ColRowsCount). Ключ сортировки 1: = диапазон («A2», «B2»), Order1: = xlAscending, заголовок: = xlNo

End Sub