Excel VBAで列のアルファベットと番号を変換する関数

excelvba

A=1 M=13 みたいな

'番号から列アルファベットを取得する
'
'引数 aNumber 数字
'戻り値 対応する番号、失敗時は""
Public Function ConvertNumberToAlphabet(ByVal aNumber As String) As String
    If Not IsNumeric(aNumber) Then
        ConvertNumberToAlphabet = ""
        Exit Function
    End If
     
    Dim AlphaDict
    Set AlphaDict = CreateObject("Scripting.Dictionary")
    With AlphaDict
        .Add Key:="1", Item:="A"
        .Add Key:="2", Item:="B"
        .Add Key:="3", Item:="C"
        .Add Key:="4", Item:="D"
        .Add Key:="5", Item:="E"
        .Add Key:="6", Item:="F"
        .Add Key:="7", Item:="G"
        .Add Key:="8", Item:="H"
        .Add Key:="9", Item:="I"
        .Add Key:="10", Item:="J"
        .Add Key:="11", Item:="K"
        .Add Key:="12", Item:="L"
        .Add Key:="13", Item:="M"
        .Add Key:="14", Item:="N"
        .Add Key:="15", Item:="O"
        .Add Key:="16", Item:="P"
        .Add Key:="17", Item:="Q"
        .Add Key:="18", Item:="R"
        .Add Key:="19", Item:="S"
        .Add Key:="20", Item:="T"
        .Add Key:="21", Item:="U"
        .Add Key:="22", Item:="V"
        .Add Key:="23", Item:="W"
        .Add Key:="24", Item:="X"
        .Add Key:="25", Item:="Y"
        .Add Key:="26", Item:="Z"
    End With
     
    Dim Alphabet As String
    Dim Quotient As Long '商
    Dim Remainder As Long '余り
    Quotient = aNumber
     
    Do
        Remainder = Quotient Mod 26
        If Remainder = 0 Then
            Quotient = Quotient - 26
            Remainder = 26
        End If
         
        Alphabet = AlphaDict.Item(CStr(Remainder)) & Alphabet
        Quotient = Quotient \ 26
    Loop Until Quotient = 0
  
    ConvertNumberToAlphabet = Alphabet
End Function

'アルファベットから列番号を取得
'
'引数 aAlphabet アルファベットの文字列
'戻り値 対応する番号、失敗時は0
Public Function ConvertAlphabetToNumber(ByVal aAlphabet As String) As Long
    If aAlphabet = "" Or IsNumeric(aAlphabet) Then
        ConvertAlphabetToNumber = 0
        Exit Function
    End If
     
    Dim AlphaDict
    Set AlphaDict = CreateObject("Scripting.Dictionary")
    With AlphaDict
        .Add Key:="A", Item:=1
        .Add Key:="B", Item:=2
        .Add Key:="C", Item:=3
        .Add Key:="D", Item:=4
        .Add Key:="E", Item:=5
        .Add Key:="F", Item:=6
        .Add Key:="G", Item:=7
        .Add Key:="H", Item:=8
        .Add Key:="I", Item:=9
        .Add Key:="J", Item:=10
        .Add Key:="K", Item:=11
        .Add Key:="L", Item:=12
        .Add Key:="M", Item:=13
        .Add Key:="N", Item:=14
        .Add Key:="O", Item:=15
        .Add Key:="P", Item:=16
        .Add Key:="Q", Item:=17
        .Add Key:="R", Item:=18
        .Add Key:="S", Item:=19
        .Add Key:="T", Item:=20
        .Add Key:="U", Item:=21
        .Add Key:="V", Item:=22
        .Add Key:="W", Item:=23
        .Add Key:="X", Item:=24
        .Add Key:="Y", Item:=25
        .Add Key:="Z", Item:=26
    End With
     
    'アルファベットの分解
    Dim Chars() As String
    ReDim Chars(Len(aAlphabet) - 1)
     
    Dim i As Long
    For i = LBound(Chars) To UBound(Chars)
        Chars(i) = Mid(aAlphabet, i + 1, 1)
    Next i
     
    Dim Number As Long
    Dim Cnt As Long
    For i = UBound(Chars) To LBound(Chars) Step -1
        If Not AlphaDict.Exists(Chars(i)) Then
            ConvertAlphabetToNumber = 0
            Exit Function
        End If
         
        Number = Number + AlphaDict.Item(Chars(i)) * (26 ^ Cnt)
        Cnt = Cnt + 1
    Next i
    ConvertAlphabetToNumber = Number
End Function

ネタ元