Excel阿拉伯数字与罗马数字转换

• 将阿拉伯数字转换为罗马数字作为文本 ROMAN
• 将罗马数字转换为阿拉伯数字 ARABIC

Excel根据罗马数字对包含罗马数字的文字排序

Function GetRomanNum(strInput As String) As String
    Dim rMatch As Object
    Dim s As String
    Dim arrayMatches()
    Dim i As Long
    
    With New RegExp
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        .Pattern = "M{0,4}(CM|CD|D?C{0,3})(XC|XL|L?X{0,3})(IX|IV|V?I{0,3})"
        If .Test(strInput) Then
            For Each rMatch In .Execute(strInput)
                ReDim Preserve arrayMatches(i)
                arrayMatches(i) = rMatch.Value
                i = i + 1
            Next
        End If
    End With
    GetRomanNum = Join(arrayMatches, " ")
End Function

Function Test() As Dictionary
    Dim dict As Object
    Dim key As Variant
    Set dict = CreateObject("Scripting.Dictionary")
    For Each Rng In Range("d1:d3")
        'Debug.Print Rng.Text
        'Debug.Print WorksheetFunction.Arabic(GetRomanNum(Rng.Text))
        dict.Add Rng.Text, WorksheetFunction.Arabic(GetRomanNum(Rng.Text))
    Next Rng
    SortDictionary dict
       With dict
        For Each key In .Keys
            'Debug.Print key, .Item(key)
        Next
    End With
    Set Test = dict
End Function

Sub Max()
    Dim dict As Dictionary
    Set dict = Test()
    Debug.Print "result"
    Debug.Print dict.Keys(0)
End Sub

Sub SortDictionary(dict As Object)
    Dim i As Long
    Dim key As Variant

    With CreateObject("System.Collections.SortedList")
        For Each key In dict
            .Add key, dict(key)
        Next
        dict.RemoveAll
        For i = 0 To .Keys.Count - 1
            dict.Add .getkey(i), .Item(.getkey(i))
        Next
    End With
End Sub