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-94774102-B

LC-94774 102-AA

Обратите внимание, что он НЕ сортируется следующим образом: (Вот как в настоящее время сортируется)

LC-94774 102-A

LC-94774 102-AA

LC-94774 102-B

Обратите внимание, как сначала сортируется буква A, а затем буква B.Я хочу, чтобы он шел сначала буквами алфавита, а затем AA AB AC..etc (вроде как MS Excel настраивается в столбцах)

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

Ron Rosenfeld · Answer 1 · 10 апреля 2019

Похоже, что вы хотите отсортировать

Столбец B: По возрастанию для первой части строки в произвольном порядке
Столбец B: убывание второй части (числовой) строки
Столбец C: по возрастанию для числовой части
Столбец C: по возрастанию длины альфа-части
Столбец C: по возрастанию альфа-части строки

Для столбца B две части можно разделить на дефис Для столбца C, поскольку дефис не всегда, я использовал регулярные выражения для разделения буквенной и числовой частей, но можно использовать и другие методы.

Используемый метод состоит в том, чтобы разбить данные на несколько столбцов и отсортировать их по мере необходимости. Эта сортировка выполняется на одноразовом листе, а затем результаты копируются обратно на исходный лист.

Для кода я сместил результаты из оригинала для целей отладки, так как могут быть конфигурации, для которых вы не предоставили информацию. Но он дает желаемые результаты на ваших тестовых данных.

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

'input data to variant array
Set ws = Worksheets("Telecom")
With ws
    vSrc = .Range(.Cells(1, 2), .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:=xlDescending, 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, 5).Resize(UBound(vRes1, 1), 2)
With Application
    .ScreenUpdating = False
With r
    .EntireColumn.Clear
    .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

Как отсортировать список по алфавиту и в зависимости от длины

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

1 Ответ

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Как отсортировать список по алфавиту и в зависимости от длины

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

1 Ответ

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Нет похожих вопросов