Перевод адреса ячейки из одного формата в другой

Debug.Print Range("$A$1").Address(, , xlR1C1)
Debug.Print [R1C1].Address()

MsgBox Application.ConvertFormula("$A$1", xlA1, xlR1C1)
MsgBox Application.ConvertFormula("R1C1", xlR1C1, xlA1)

Option Explicit
'Функция преобразования адреса ячейки из одного формата в другой.
Function ConvertAddress(addr As String) As String
    Dim v As Variant
    v = Application.ConvertFormula(addr, xlA1, xlR1C1)
    If VarType(v) = vbError Then v = Application.ConvertFormula(addr, xlR1C1, xlA1)
    ConvertAddress = CStr(v)
End Function
'The sub must me named with word "Task" and task ID.
Sub Task1043A()
    Dim vvod As Worksheet, vyvod As Worksheet
    Dim i As Integer, n As Integer
    Set vvod = Sheets("Input")
    Set vyvod = Sheets("Output")
    'Ввод кол-ва адресов для обработки.
    n = vvod.Range("A1").Value
    'Обработка адресов.
    For i = 1 To n
        vyvod.Cells(i, 1).Value = ConvertAddress(vvod.Cells(i, 2).Value)
    Next i
End Sub

'Функция преобразования адреса ячейки из одного формата в другой.
Function ConvertAddress(addr As String) As String
    Dim v As Variant
    v = Application.ConvertFormula(addr, xlA1, xlR1C1)
    'Если адрес не в формате A1.
    If VarType(v) = vbError Then
        v = Application.ConvertFormula(addr, xlR1C1, xlA1)
        'и не в формате R1C1, то это вообще не адрес.
        If VarType(v) = vbError Then
            ConvertAddress = "Неверный формат"
            Exit Function
        Else
            'Адрес должен быть адресом одной ячейки.
            If Range(v).Cells.Count > 1 Then
                ConvertAddress = "Неверный формат"
                Exit Function
            End If
            'Адрес должен быть абсолютным.
            If Application.ConvertFormula(v, xlA1, xlR1C1, True) <> addr Then
                ConvertAddress = "Неверный формат"
                Exit Function
            End If
        End If
    Else
        'Адрес должен быть адресом одной ячейки.
        If Range(addr).Cells.Count > 1 Then
            ConvertAddress = "Неверный формат"
            Exit Function
        End If
        'Адрес должен быть абсолютным.
        If Application.ConvertFormula(v, xlR1C1, xlA1, True) <> addr Then
            ConvertAddress = "Неверный формат"
            Exit Function
        End If
    End If
    ConvertAddress = v
End Function
'The sub must me named with word "Task" and task ID.
Sub Task1043A()
    Dim vvod As Worksheet, vyvod As Worksheet
    Dim i As Integer, n As Integer
    Set vvod = Sheets("Input")
    Set vyvod = Sheets("Output")
    'Ввод кол-ва адресов для обработки.
    n = vvod.Range("A1").Value
    'Обработка адресов.
    For i = 1 To n
        vyvod.Cells(i, 1).Value = ConvertAddress(vvod.Cells(i, 2).Value)
    Next i
End Sub

Function CVAddr(addr As String) As String
Static re As Object
Dim v As Object
  If re Is Nothing Then
    Set re = CreateObject("vbscript.regexp")
    re.Pattern = "r(\d+)c(\d+)|\$([a-z]+)\$(\d+)"
    re.ignorecase = True
  End If
  On Error GoTo 1
  Set v = re.Execute(addr)
  If v.Count Then
    If v(0) = addr Then
      If IsEmpty(v(0).submatches(0)) Then 'A1
        CVAddr = Application.ConvertFormula(addr, xlA1, xlR1C1)
      Else
        CVAddr = Application.ConvertFormula(addr, xlR1C1, xlA1)
      End If
      Exit Function
    End If
  End If
1 CVAddr = "Неверный формат"
End Function

Function ConvertAddress(ByVal addr As String) As String
Dim r As Range
  addr = UCase(addr)
  On Error Resume Next
  Set r = Worksheets(1).Range(addr)
  If Err Then 'R1C1?
    Err.Clear
    addr = Application.ConvertFormula(addr, xlR1C1, xlA1)
    Set r = Worksheets(1).Range(addr)
    If Err Then GoTo 1
    If r.Count = 1 And r.Address = addr Then
      ConvertAddress = addr
      Exit Function
    End If
  ElseIf r.Count = 1 And r.Address = addr Then
    ConvertAddress = r.Address(, , xlR1C1)
    Exit Function
  End If
1 ConvertAddress = "Неверный формат"
End Function

'Добавление заданной буквы в конец слова.
Function AddLetter(slovo() As Integer, letter As String) As Boolean
    Const LATIN_LETTERS_NUM = 26, BASE = 100
    Dim i As Integer, carry As Integer
    If Asc(letter) < 65 Or Asc(letter) > 90 Then Exit Function
    For i = LBound(slovo) To UBound(slovo)
        If slovo(i) = -1 Then
            If carry <> 0 Then slovo(i) = carry
            Exit For
        End If
        slovo(i) = slovo(i) * LATIN_LETTERS_NUM + carry
        carry = slovo(i) \ BASE
        slovo(i) = slovo(i) Mod BASE
    Next i
    carry = Asc(letter) - Asc("A") + 1
    For i = LBound(slovo) To UBound(slovo)
        If carry = 0 Then Exit For
        If slovo(i) = -1 Then
            slovo(i) = carry
            Exit For
        End If
        slovo(i) = slovo(i) + carry
        carry = slovo(i) \ BASE
        slovo(i) = slovo(i) Mod BASE
    Next i
    AddLetter = True
End Function
'Отнятие буквы от конца слова.
Function RemoveLetter(slovo() As Integer) As String
    Const LATIN_LETTERS_NUM = 26, BASE = 100
    Dim i As Integer, remainder As Integer
    Select Case slovo(LBound(slovo))
        Case -1
        Case 0, 1
            slovo(LBound(slovo)) = slovo(LBound(slovo)) - 1
        Case Else
            For i = LBound(slovo) To UBound(slovo)
                If slovo(i) = 0 Then
                    slovo(i) = BASE - 1
                Else
                    If slovo(i) = 1 Then slovo(i) = -1 Else slovo(i) = slovo(i) - 1
                    Exit For
                End If
            Next i
    End Select
    For i = UBound(slovo) To LBound(slovo) Step -1
        If slovo(i) <> -1 Then Exit For
    Next i
    If i >= LBound(slovo) Then
        remainder = slovo(i) Mod LATIN_LETTERS_NUM
        slovo(i) = slovo(i) \ LATIN_LETTERS_NUM
        If slovo(i) = 0 Then slovo(i) = -1
    End If
    For i = i - 1 To LBound(slovo) Step -1
        slovo(i) = slovo(i) + remainder * BASE
        remainder = slovo(i) Mod LATIN_LETTERS_NUM
        slovo(i) = slovo(i) \ LATIN_LETTERS_NUM
    Next i
    RemoveLetter = Chr(remainder + Asc("A"))
End Function
'Преобразование слова в строку десятичных цифр.
Function ToDecimal(slovo As String) As String
    Dim i As Integer, slovo2(0 To 99) As Integer, s As String, d As String
    For i = LBound(slovo2) To UBound(slovo2)
        slovo2(i) = -1
    Next i
    For i = 1 To Len(slovo)
        If AddLetter(slovo2, Mid(slovo, i, 1)) = False Then Exit Function
    Next i
    For i = UBound(slovo2) To LBound(slovo2) Step -1
        If slovo2(i) <> -1 Then Exit For
    Next i
    For i = i To LBound(slovo2) Step -1
        If slovo2(i) < 10 Then s = "0" & slovo2(i) Else s = slovo2(i)
        d = d & s
    Next i
    If Left(d, 1) = "0" Then d = Mid(d, 2)
    ToDecimal = d
End Function
'Преобразование строки десятичных цифр в слово.
Function ToSlovo(dec As String) As String
    Dim i As Integer, j As Integer, slovo(0 To 9) As Integer
    For i = LBound(slovo) To UBound(slovo)
        slovo(i) = Right(dec, 2)
        If Len(dec) <= 2 Then
            For j = i + 1 To UBound(slovo)
                slovo(j) = -1
            Next j
            Exit For
        End If
        dec = Left(dec, Len(dec) - 2)
    Next i
    While slovo(0) <> -1
        ToSlovo = RemoveLetter(slovo) & ToSlovo
    Wend
End Function
'Функция преобразования адреса ячейки из одного формата в другой.
Function ConvertAddress(addr As String) As String
    Dim i As Integer, a As String, b As String, d As String
    If addr Like "$*$*" Then
        i = InStr(2, addr, "$")
        a = Mid(addr, 2, i - 2)
        b = Mid(addr, i + 1)
        If IsNumeric(b) And Val(b) > 0 Then
            d = ToDecimal(a)
            If Len(d) Then
                ConvertAddress = "R" & b & "C" & d
                Exit Function
            End If
        End If
    ElseIf addr Like "R*C*" Then
        i = InStr(2, addr, "C")
        a = Mid(addr, 2, i - 2)
        b = Mid(addr, i + 1)
        If IsNumeric(a) And Val(a) > 0 Then
            If IsNumeric(b) And Val(b) > 0 Then
                ConvertAddress = "$" & ToSlovo(b) & "$" & a
                Exit Function
            End If
        End If
    End If
    ConvertAddress = "Неверный формат"
End Function
'The sub must me named with word "Task" and task ID.
Sub Task1043A()
    Dim vvod As Worksheet, vyvod As Worksheet
    Dim i As Integer, n As Integer
    Set vvod = Sheets("Input")
    Set vyvod = Sheets("Output")
    'Ввод кол-ва адресов для обработки.
    n = vvod.Range("A1").Value
    'Обработка адресов.
    For i = 1 To n
        vyvod.Cells(i, 1).Value = ConvertAddress(vvod.Cells(i, 2).Value)
    Next i
End Sub

Function Num2hdr$(ByVal n)
Dim m
  If VarType(n) <> vbDecimal Then n = CDec(n)
  While n
    m = Int((n - 1) / 26)
    Num2hdr = Chr$(n - m * 26 + 64) & Num2hdr
    n = m
  Wend
End Function
 
Function Hdr2num(ByVal s$)
Dim i&
  Hdr2num = CDec(0)
  For i = 1 To Len(s)
    Hdr2num = Hdr2num * 26 - 64 + Asc(Mid$(s, i, 1))
  Next
End Function