在排序宏中使用VBA函数

时间:2018-06-01 13:10:34

标签: excel vba function sorting

我维护一个包含多列数据的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 :(得分:4)

添加一列用作帮助者;然后填充然后对新列进行排序;删除新列。

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