Доброго дня! Подскажите макрос, который преобразовывает число в текст с учетом формата ячеек. Знаю, что в известных надстройках присутствует данный функционал, но избыточен для меня, например не нужен откат выполненных действий (это тоже потраченное время). Интересует максимальное быстродействие на большом массиве.
Спасибо всем! Но интересует именно преобразование текущих ячеек, без использования функций и добавления дополнительных столбцов. Начал писать макрос, но остановился на том, что надо прочитать содержимое ячейки + использовать функцию + записать итоговый результат в ячейку. Я новичок в макросах по разному писал код, всякие ошибки выпадали. Помогите дописать. Или где-то есть уже готовый макрос.
Код
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 t()
Dim cl As Range, tx$
For Each cl In Selection
tx = Application.Text(cl.Value, cl.NumberFormat)
cl.NumberFormat = "@"
cl.Value = tx
Next cl
End Sub
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Итого получился код с % выполнения, может кому понадобиться
Код
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