Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.53/15: Рейтинг темы: голосов - 15, средняя оценка - 4.53
29 / 15 / 12
Регистрация: 09.02.2018
Сообщений: 90
1

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

19.10.2018, 17:17. Просмотров 2807. Ответов 10
Метки нет (Все метки)

Хей други, скажите как перевести абсолютный адрес одной ячейки из формата A1 в формат R1C1 и обратно.

Например, $A$1 -> R1C1, R1C1 -> $A$1.
0
Лучшие ответы (1)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
19.10.2018, 17:17
Ответы с готовыми решениями:

Изменения формата ячейки Excel средствами VBA в зависимости от значения другой ячейки
Здравствуйте. Столкнулся с проблемой. Необходимо на листе Excel Залить, предположим, ячейку "C4"...

Копировать ячейки с красным шрифтом с одного листа на другой
Добрый День! Есть задача копировать с листа3 на лист1 ячейки(всего их 30) с красным шрифтом....

Как вытащить значение ячейки из одного документа в другой
Есть документ, который служит для расчета проектных данных и фактических. В этот документ нужно по...

Копирование значения ячейки с одного листа и вставка в другой
Здравствуйте! Делаю дз по информатике, VBA. Задание заключается вот в чем: есть два листа в...

10
Заблокирован
19.10.2018, 18:47 2
Visual Basic
1
2
Debug.Print Range("$A$1").Address(, , xlR1C1)
Debug.Print [R1C1].Address()
0
29 / 15 / 12
Регистрация: 09.02.2018
Сообщений: 90
19.10.2018, 19:43  [ТС] 3
Остап Бонд,

Debug.Print [R1C1].Address() выбивает ошибку:

Run-time error '424'
Object required

Добавлено через 4 минуты
Если глобально поменять стиль ссылок в документе на R1C1, то пашут оба варианта, но я не имею доступа к компу, на котором тестируются программы, так что нуна найти другое решение.
0
4056 / 2178 / 922
Регистрация: 01.12.2010
Сообщений: 4,541
19.10.2018, 21:00 4
Visual Basic
1
2
MsgBox Application.ConvertFormula("$A$1", xlA1, xlR1C1)
MsgBox Application.ConvertFormula("R1C1", xlR1C1, xlA1)
1
29 / 15 / 12
Регистрация: 09.02.2018
Сообщений: 90
19.10.2018, 22:16  [ТС] 5
pashulka, воспользовался вашим вариантом, вымучил следующий код:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
Получаю Wrong Answer на 3 тесте:

Код
Test #3
----------------
3
A1
R[1]C[1]
$A$1R1C1
----------------
"A1": expected "Неверный формат", got "RC"
"R[1]C[1]": expected "Неверный формат", got "B2"
"$A$1R1C1": expected "Неверный формат", got "Error 2015"
----------------
Wrong Answer
Это поправимо?
0
14927 / 6328 / 1721
Регистрация: 24.09.2011
Сообщений: 9,977
19.10.2018, 22:34 6
КулХацкеръ, а, это учебное задание. Приведите условие ПОЛНОСТЬЮ.
Существуют адреса, которые являются допустимыми в обеих стилях, но означают разные диапазоны, например
R3 - относительная ссылка на одну ячейка в А1, абсолютная ссылка на 3-ю строку в R1C1;
C5:C7 - относительная ссылка на диапазон в А1, абсолютная ссылка на 3 столбца в R1C1.
0
29 / 15 / 12
Регистрация: 09.02.2018
Сообщений: 90
20.10.2018, 17:25  [ТС] 7
Казанский,

Задание полностью:

В ячейке A1 листа "Input" дано n - количество адресов для обработки.
В диапазоне B1:Bn листа "Input" - абсолютные адреса одной ячейки для обработки в форматах A1 и/или R1C1.
Для каждой ячейки диапазона B1:Bn листа "Input" вывести в соответствующую ячейку диапазона A1:An листа "Output" адрес ячейки, представленный в другом формате.

Для R3 ответ должен быть "Неверный формат"! ни относительные ссылки, ни диапазоны не допускаются согласно условию, допускаются только абсолютные ссылки на одну ячейку.
Для C5:C7 ответ должен быть "Неверный формат".

Добавлено через 1 час 0 минут
Кто-нибудь мне поможет?

Добавлено через 4 часа 48 минут
OK, с 3 тестом разобрался самостоятельно:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
'Функция преобразования адреса ячейки из одного формата в другой.
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
Помогите доработать.

Добавлено через 1 час 25 минут
Казанский, дружище, помоги плиз.
0
14927 / 6328 / 1721
Регистрация: 24.09.2011
Сообщений: 9,977
22.10.2018, 11:44 8
КулХацкеръ, несколько другой подход
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
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
Добавлено через 11 часов 3 минуты
КулХацкеръ, впрочем, вашу функцию тоже можно допилить
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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
1
29 / 15 / 12
Регистрация: 09.02.2018
Сообщений: 90
25.10.2018, 22:50  [ТС] 9
Казанский, спс за отклик!

Сегодня наконец добил этот несчастный тест №8. Как оказалось, там адреса вида R100000C100000 или $VENIVIDIVICI$1 (правильные ответы соответственно $EQXD$100000 и R1C81531486219181787). Функция ConvertFormula в таких случаях работает неправильно.

Выкладываю финальное решение. Можно использовать вместо функции ConvertFormula в случаях, когда последняя работает неправильно.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
'Добавление заданной буквы в конец слова.
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
1
14927 / 6328 / 1721
Регистрация: 24.09.2011
Сообщений: 9,977
26.10.2018, 19:13 10
Лучший ответ Сообщение было отмечено КулХацкеръ как решение

Решение

КулХацкеръ, круто! В задаче вообще нет ограничений на диапазон чисел, что ли?
То есть это задача по сути на длинную арифметику?
Если все же ограничиться диапазоном числового типа Decimal, то можно использовать эти простые функции для преобразования числа в заголовок столбца и обратно
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
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
Тесты в Immediate
Код
?Hdr2num("VENIVIDIVICI")
 81531486219181787 
?num2hdr("81531486219181787")
VENIVIDIVICI
?num2hdr("79228162514264337593543950335") 'максимальное число для Decimal
CYINSIUCHLMYHBFRQZDEM
?hdr2num("CYINSIUCHLMYHBFRQZDEM")
 79228162514264337593543950335
2
29 / 15 / 12
Регистрация: 09.02.2018
Сообщений: 90
08.11.2018, 22:11  [ТС] 11
Казанский, вашего решения также хватает для прохождения всех тестов.
Здорово, что задача так лаконично и красиво решается!
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
08.11.2018, 22:11

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь.

Копирование данных из ячейки одного листа на другой с условием
Копирование данных из ячейки одного листа на другой с условием На листе 1 в ячейках B4: ......

Копирование данных из ячейки одного листа на другой перед тире
Скажите, необходимо скопировать из Листа1 ячееки F4: ... в лист 2 в ячейки I данные которые ...

Скопировать столбец ФИО из одного листа на другой лист с разбивкой на 3 ячейки
Необходимо копировать столбец ФИО из одного листа на другой лист с разбивкой на 3 ячейки Здесь...

Копирование значения ячейки из одного листа в другой при соблюдений условии
Добрый день! Помогите написать макрос для решения следующей проблемы. Имеется таблица Excel,...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
11
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.