Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
VBA. Преобразовать число в текст с учетом формата ячеек.
 
#1
08.09.2021 15:49:11
Доброго дня!
Подскажите макрос, который преобразовывает число в текст с учетом формата ячеек.
Знаю, что в известных надстройках присутствует данный функционал, но избыточен для меня, например не нужен откат выполненных действий (это тоже потраченное время). Интересует максимальное быстродействие на большом массиве.

Какие команды могут прочитать формат ячеек?

Пример во вложении
Изменено: Максим - 08.09.2021 15:51:33
 
 
 
#2
08.09.2021 16:20:50
Доброе время суток.
Изучите Range.Text property (Excel)
 
 
 
#3
08.09.2021 16:21:16
Максим, UDF - лежит здесь: https://www.excel-vba.ru/chto-umeet-excel/vidimoe-znachenie-yachejki-v-realnoe/
Код
Function VisualVal_Text(rc As range)
    VisualVal_Text = rc.Text
End Function
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#4
09.09.2021 08:26:45
Mershik, в той же теме, написано почему это плохое решение.
Итоговое такое:
Код
Function VisualVal(rc As Range)
    VisualVal = Application.Text(rc.Value, rc.NumberFormat)
End Function
Изменено: bedvit - 09.09.2021 08:27:06
«Бритва Оккама» или «Принцип Калашникова»?
 
 
 
#5
09.09.2021 10:30:27
Спасибо всем! Но интересует именно преобразование текущих ячеек, без использования функций и добавления дополнительных столбцов.
Начал писать макрос, но остановился на том, что надо прочитать содержимое ячейки + использовать функцию + записать итоговый результат в ячейку. Я новичок в макросах по разному писал код, всякие ошибки выпадали. Помогите дописать. Или где-то есть уже готовый макрос.

Код
Function VisualVal(rc As Range)
    VisualVal = Application.Text(rc.Value, rc.NumberFormat)
End Function
Sub Преобразование()


'    On Error Resume Next
    Dim i, x, y As Long

    x = ActiveCell.Column
    y = ActiveCell.Row
    For i = 0 To Selection.Count - 1
    Cells(i + y, x).Select

???
    
    Selection.Value = Selection.Value ' преобразование формул в значение
    
' для визуализации
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With


Next
End Sub
 
 
 
#6
09.09.2021 10:37:13
Цитата
Максим написал:
без использования функций и добавления дополнительных столбцов
странное требование про "без функций". Чем они Вам помешали-то? :) Не знаю зачем там у Вас всякие заливки устанавливаются, поэтому подправил как мог
Код
Function VisualVal(rc As Range)
    VisualVal = Application.Text(rc.Value, rc.NumberFormat)
End Function
Sub Преобразование()
Dim rc As Range, sres$
For Each rc In Selection.Cells
    sres = VisualVal(rc)
    'назначаем текстовый формат ячейкам, чтобы избежать лишних преобразований
    rc.NumberFormat = "@"
    rc.Value = sres
Next
     
' для визуализации
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub
есть нюансы, который надо использовать по ситуации. Например, если для ячеек установлен формат вроде такого "0000000" и в значении будут ведущие нули - то назначение текстового формата для ячейки перед записью значений обязательно.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#7
09.09.2021 10:39:25
Код
Sub Преобразование()
    Dim cl As Range
    For Each cl In Selection
        cl = VisualVal(cl)
    Next
End Sub
 
 
 
#8
09.09.2021 10:42:23
RAN, если формат ячеек на листе изначально Общий(General), то не все ячейки смогут преобразоваться корректно.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#9
09.09.2021 10:46:17
#7 полностью рабочий  :idea:
Без заливок и прочего лишнего от ТСа:
Изменено: Jack Famous - 09.09.2021 10:47:04
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#10
09.09.2021 10:46:25
Согласен, не додумал.
 
 
 
#11
09.09.2021 11:15:46
Большое спасибо все участникам! Очень помогли.
Закраску я делал для визуализации, что цикл отработан.
Изменено: Максим - 09.09.2021 11:16:09
 
 
 
#12
10.09.2021 11:57:11
Итого получился код с % выполнения, может кому понадобиться
Код
Function VisualVal(rc As Range)
    VisualVal = Application.Text(rc.Value, rc.NumberFormat)
End Function

Sub Преобразование_число_в_текст()
Dim rc As Range, calc, ab, xy, a As Long, sres$
'начало отсчета времени
'a = Timer

    Application.CutCopyMode = False
    ab = Selection.Count
    ' Отключение пересчёта формул, чтобы ускорить макрос.
    ' Перед отключением запоминаем режим формул, чтобы потом его вернуть.
    calc = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

For Each rc In Selection.Cells
    sres = VisualVal(rc)
    'назначаем текстовый формат ячейкам, чтобы избежать лишних преобразований
    rc.NumberFormat = "@"
    rc.Value = sres
    
    xy = xy + 1
'    Application.StatusBar = "Выполнено: " & xy & " из " & ab  ' кол-во обработанных ячеек
    Application.StatusBar = "Выполнено: " & Int(100 * xy / ab) & "%"  ' процент обработанных ячеек
'    DoEvents 'чтобы форма перерисовывалась
Next

    'сбрасываем значение статусной строки
    Application.StatusBar = False
    ' Включение того, что отключили.
    Application.ScreenUpdating = True
    Application.Calculation = calc


'вывод затраченного времени
'MsgBox Timer - a

End Sub
 
 
 
Страницы: 1
Читают тему
Наверх