Используйте функцию VBA внутри макроса сортировки - PullRequest
0 голосов
/ 01 июня 2018

Я поддерживаю электронную таблицу Excel с данными в нескольких столбцах, которые можно сортировать различными способами, если каждый пользователь считает это полезным.Я настроил это с помощью макросов с кнопками на листах, которые выполняют различные сортировки

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

Я нашел функцию, которая выполняет это, и называется "num ()".Я хотел бы использовать эту функцию без изменения данных в самом столбце.Вот пример того, для чего я снимаю:

Sub sortscenarionum()
'
' sortscenarionum Macro
' Sort Aircraft by FLIGHT NUMBER then RPO TIME
'
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
        "N11:N159"), SortOn:=num("N11:N159"), Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
        "I11:I159"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range("B11:N159")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    SendKeys "{ESC}"
End Sub

Это не с «Несоответствие типов».Я также пробовал SortOn: = num (xlSortValues) с такими же отрицательными результатами.У меня нет проблем с перемещением функции в сам макрос, но я понятия не имею, как это сделать.Вот функция, если она полезна:

Function num(rng As Range) As String
Dim n As Integer
For n = 1 To Len(rng)
If Mid(rng, n, 1) Like "[0-9]" Then
num = num & Mid(rng, n, 1)
End If
Next n
End Function

1 Ответ

0 голосов
/ 01 июня 2018

Добавить столбец, который будет использоваться в качестве помощника;заполнить и отсортировать по новому столбцу;удалить новый столбец.

Sub sortscenarionum()
    With ActiveWorkbook.ActiveSheet
        .Columns("O").Insert
        With .Range(.Cells(11, "B"), .Cells(.Rows.Count, "N").End(xlUp).Offset(0, 1))
            .Columns(.Columns.Count).Formula = "=numsOnly(N11)"
            .Columns(.Columns.Count).Value = .Columns(.Columns.Count).Value
            .Sort Key1:=.Columns(.Columns.Count), Order1:=xlAscending, _
                  Key2:=.Columns(8), Order2:=xlAscending, _
                  Orientation:=xlTopToBottom, Header:=xlNo
        End With
        .Columns("O").Delete
    End With
End Sub

Function numsOnly(str As String)    
    'with rgx as static, it only has to be created once
    Static rgx As Object
    If rgx Is Nothing Then
        Set rgx = CreateObject("VBScript.RegExp")
    End If
    numsOnly = vbNullString

    With rgx
        .Global = True
        .MultiLine = False
        .Pattern = "[0-9]{1,5}$"
        If .test(str) Then
            numsOnly = CLng(.Execute(str)(0))
        End If
    End With
End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...