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

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

Пример во вложении
Изменено: Максим - 08.09.2021 15:51:33
 
Доброе время суток.
Изучите Range.Text property (Excel)
 
Максим, 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
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, в той же теме, написано почему это плохое решение.
Итоговое такое:
Код
Function VisualVal(rc As Range)
    VisualVal = Application.Text(rc.Value, rc.NumberFormat)
End Function
Изменено: bedvit - 09.09.2021 08:27:06
«Бритва Оккама» или «Принцип Калашникова»?
 
Спасибо всем! Но интересует именно преобразование текущих ячеек, без использования функций и добавления дополнительных столбцов.
Начал писать макрос, но остановился на том, что надо прочитать содержимое ячейки + использовать функцию + записать итоговый результат в ячейку. Я новичок в макросах по разному писал код, всякие ошибки выпадали. Помогите дописать. Или где-то есть уже готовый макрос.

Код
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
 
Цитата
Максим написал:
без использования функций и добавления дополнительных столбцов
странное требование про "без функций". Чем они Вам помешали-то? :) Не знаю зачем там у Вас всякие заливки устанавливаются, поэтому подправил как мог
Код
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" и в значении будут ведущие нули - то назначение текстового формата для ячейки перед записью значений обязательно.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Код
Sub Преобразование()
    Dim cl As Range
    For Each cl In Selection
        cl = VisualVal(cl)
    Next
End Sub
 
RAN, если формат ячеек на листе изначально Общий(General), то не все ячейки смогут преобразоваться корректно.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
#7 полностью рабочий  :idea:
Без заливок и прочего лишнего от ТСа:
Изменено: Jack Famous - 09.09.2021 10:47:04
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Согласен, не додумал.
 
Большое спасибо все участникам! Очень помогли.
Закраску я делал для визуализации, что цикл отработан.
Изменено: Максим - 09.09.2021 11:16:09
 
Итого получился код с % выполнения, может кому понадобиться
Код
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
Читают тему (гостей: 1)
Наверх