学以致用-Excel Arabic函数（将阿拉伯数字转换为罗马数字）的VBA实现

看到的资料中使用了罗马字序号（XVI），比较好奇这个序号对应的阿拉伯数字是多少。

于是，百度了一下，学到了两个新的Excel函数：ROMAN()和ARABIC()，可以实现罗马数字（I, II, III ...）与阿拉伯数字（1, 2, 3, ...）的相互转换。

问题是，在我的Excel 2016中，ARABIC函数似乎不存在（出现了#NAME#错误）。

所以，让我们来使用VBA实现一个类似于ARABIC函数功能吧。

运行这段代码，在输入框中输入要转换的罗马字，即可得到对应的阿拉伯数字。

源码如下：

Sub ArabicFunction()
'
' Convert a Roman number to Arabic number (from 1 to 3999)
'

'
    Application.ScreenUpdating = False
    
    ActiveSheet.Select
    Range("A1").Value = 1
    Range("A1").Select
    Selection.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
        Step:=1, Stop:=3999, Trend:=False
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "=ROMAN(RC[-1])"
    Range("B1").Select
    Selection.AutoFill Destination:=Range("B1:B3999")
    Range("B1:B3999").Select
    Range("B1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("C1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("D1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    ActiveWorkbook.Names.Add Name:="vl_arabic", RefersToR1C1:= _
        "=R1C3:R3999C4"
    ActiveWindow.SmallScroll Down:=-9
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Roman"
    Range("F1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5296274
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "Arabic"
    Range("F2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    Range("F2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "V"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(R[-1]C,vl_arabic,1,FALSE)"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(R[-1]C,vl_arabic,2,FALSE)"
    Range("G2").Select
    
    Application.ScreenUpdating = True
End Sub