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

'Добавление заданной буквы в конец слова.
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