RFpro.ru: Пакет Microsoft Office

  Все выпуски  

RFpro.ru: Пакет Microsoft Office


РАССЫЛКИ ПОРТАЛА RFPRO.RU

Лучшие эксперты в разделе

Megaloman
Статус: Мастер-Эксперт
Рейтинг: 144
∙ повысить рейтинг »
CradleA
Статус: Академик
Рейтинг: 86
∙ повысить рейтинг »
Valery N
Статус: Мастер-Эксперт
Рейтинг: 2
∙ повысить рейтинг »

∙ Пакет MSOffice

Номер выпуска:1028
Дата выхода:08.03.2021, 15:15
Администратор рассылки:Megaloman (Мастер-Эксперт)
Подписчиков / экспертов:9 / 30
Вопросов / ответов:1 / 1

Консультация # 200370: Прошу помощи в следующем вопросе Считать с первого столбца рабочего листа N (N вводится с клавиатуры) вещественных чисел типа Single. Перевести числа в шестнадцатеричный формат и вывести в соседний столбец. В шестнадцатеричном представлении числа поменять 1-ую цифру с 8-ой, 2-ую - с 7-ой, 3-ю с 6-ой, 4-ю с 5-ой и т.д. Полученное число переве...

Консультация # 200370:

Прошу помощи в следующем вопросе
Считать с первого столбца рабочего листа N (N вводится с
клавиатуры) вещественных чисел типа Single. Перевести числа в шестнадцатеричный формат и вывести в соседний столбец. В шестнадцатеричном представлении числа поменять 1-ую цифру с 8-ой, 2-ую - с 7-ой, 3-ю с 6-ой, 4-ю с 5-ой и т.д. Полученное число перевести в
десятичную систему счисления и вывести в 3 столбец рабочего листа.

Заранее спасибо

Дата отправки: 03.03.2021, 14:47
Вопрос задал: 23071996 (Посетитель)
Всего ответов: 1
Страница онлайн-консультации »


Консультирует Megaloman (Мастер-Эксперт):

Здравствуйте, 23071996!
Вы не описали требований к методике конвертации чисел в разные системы счисления, поэтому, в соответствии с принципом: "Не стоит множить сущности без необходимости" - при написании макроса использую стандартные функции листов Excel: Dec2Hex и Hex2Dec.

Sub Sub_200370()

Const RA = "A1"             ' Адрес ячейки с первым элементом массива чисел
    
Dim N, CN, ierr
Dim RRA, In10, N1, N2, i, j
Dim RB, RRB
Dim RC, RRC
Dim RD, RRD

N = InputBox("Введите целое N>0")

ierr = False
If IsNumeric(N) Then
    CN = CDbl(N)
    ierr = CDbl(CN) > 0 And Int(CN) = CN
End If

If Not ierr Then
    MsgBox "Введено неверное число" + vbCrLf + N
    Exit Sub
End If

ReDim In10(1 To N, 1) As Single
ReDim In16(1 To N)
ReDim Out10(1 To N)

Cells.Interior.Pattern = xlNone
Cells.Font.ColorIndex = xlAutomatic
    
RRA = RA + ":" + Range(RA).Offset(N - 1, 0).Address

RB = Range(RA).Offset(0, 1).Address
RRB = RB + ":" + Range(RB).Offset(N - 1, 0).Address

RC = Range(RA).Offset(0, 2).Address
RRC = RC + ":" + Range(RC).Offset(N - 1, 0).Address
    
In10 = Range(RRA)
N1 = LBound(In10, 1)
N2 = UBound(In10, 1)

For i = N1 To N2
    If IsNumeric(In10(i, 1)) And Len(Trim(In10(i, 1))) > 0 Then
        Range(RA).Offset(i - 1, 0).Font.Color = -11489280
        In16(i) = CStr(Application.WorksheetFunction.Dec2Hex(In10(i, 1)))
        Out10(i) = Application.WorksheetFunction.Hex2Dec(Exch(CStr(In16(i))))
    Else
        Range(RA).Offset(i - 1, 0).Font.Color = -16776961
        In16(i) = ""
        Out10(i) = ""
    End If
Next

Range(RRB) = Application.WorksheetFunction.Transpose(In16)
Range(RRC) = Application.WorksheetFunction.Transpose(Out10)

End Sub

Function Exch(S As String)
    Dim SS, k, j
    k = Len(Trim(S))
    SS = ""
    For j = k To 1 Step -1
        SS = SS + Mid(S, j, 1)
    Next
    Exch = SS
End Function

Вот результат работы макроса:



Здесь выбрано 17 десятичных чисел в столбце A, они макросом подсвечены зелёным, за исключением пустой ячейки и ячейки с нецифровым содержимым.
В столбце B они преобразованы макросом в шестнадцатиричное представление, в столбце C показан результат конвертации инвертированной строки с шестнадцатиричным значением исходного значения в десятичный формат.
В столбце E справочно, для контроля работы макроса, без привлечения макроса, отображено преобразование десятичного числа в столбце C в шестнадцатиричный формат, чтобы убедиться, что числа в столбце B инвертированы верно - в задании этого нет.
Excel-файл с примерами прилагаю.

Консультировал: Megaloman (Мастер-Эксперт)
Дата отправки: 03.03.2021, 22:40
Прикреплённый файл: посмотреть » [25.2 кб]
Рейтинг ответа:

НЕ одобряю 0 одобряю!


Оценить выпуск | Задать вопрос экспертам

главная страница  |  стать участником  |  получить консультацию
техническая поддержка

Дорогой читатель!
Команда портала RFPRO.RU благодарит Вас за то, что Вы пользуетесь нашими услугами. Вы только что прочли очередной выпуск рассылки. Мы старались. Пожалуйста, оцените его. Если совет помог Вам, если Вам понравился ответ, Вы можете поблагодарить автора - для этого в каждом ответе есть специальные ссылки. Вы можете оставить отзыв о работе портале. Нам очень важно знать Ваше мнение. Вы можете поближе познакомиться с жизнью портала, посетив наш форум, почитав журнал, который издают наши эксперты. Если у Вас есть желание помочь людям, поделиться своими знаниями, Вы можете зарегистрироваться экспертом. Заходите - у нас интересно!
МЫ РАБОТАЕМ ДЛЯ ВАС!


В избранное