Страницы: 1
RSS
Числа в текстовый формат без потери передних нулей
 
Здравствуйте!
Имеются числа в столбце А, например номера накладных, в числовом формате "00000",при этом есть значения с передними нулями. В приведенном примере макрос в цикле переводит эти номера в текстовый формат и при этом передние нули не отбрасываются. Как сделать макрос без цикла,чтобы сразу весь диапазон перевести в текстовый формат без отбрасывания впереди стоящих нулей.
 
Прошу пардону, не заметил "без цикла" )
Изменено: kalbasiatka - 10.09.2013 22:57:17
 
Как сделать с помощью макроса, но без  цикла, т.к. при огромном количестве чисел работа в цикле занимает время.
 
Уберите Select как минимум
 
Цикл без Select  занимает столько же времени, мерил секундомером при большом количестве строк

Sub Макрос1()
Dim r As Range
Dim x As Variant
Dim ra As Range
Set ra = Range([A1], Range("A" & Rows.Count).End(xlUp))
For Each r In ra
x = r.Text
r.NumberFormat = "@"
r = x
Next r
End Sub
Изменено: pavel68 - 10.09.2013 23:07:52
 
дело не в самом цикле, а в дурном коде.
так должно быть в разы быстрее
Код
Sub t()
    Dim a(), b()
    a = [a1].Resize(Cells(Rows.Count, 1).End(xlUp).Row).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a): b(i, 1) = Format(a(i, 1), "00000"): Next
    With [b1].Resize(UBound(b))
        .NumberFormat = "@"
        .Value = b
    End With
End Sub
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
Меряйте:
Код
Sub wwwEvaluate_1()
    Dim b, i&
    b = [a1].CurrentRegion
    [a1].CurrentRegion.NumberFormat = "@"
    For i = 1 To UBound(b)
        b(i, 1) = Format(b(i, 1), "00000")
    Next
    [a1].CurrentRegion = b
End Sub
Я сам - дурнее всякого примера! ...
 
если "без цикла" - вопрос принципа  :D
Код
Sub tt()
    With [c1:c20]
        .NumberFormat = "General"
        .FormulaArray = "=TEXT(R1C1:R20C1,""00000"")"
        .NumberFormat = "@"
        .Value = .Value
    End With
End Sub
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
Если все же числа имеют разную разрядность, то:
Код
Sub www()
    Dim r As Range, i&, t!
    Dim ra As Range
    t = Timer
    Set ra = Range([A1], Range("A" & Rows.Count).End(xlUp))
    ReDim a$(1 To ra.Count, 1 To 1)
    For Each r In ra
        i = i + 1
        a(i, 1) = r.Text
    Next r
    ra.NumberFormat = "@": ra = a
    Debug.Print Timer - t
End Sub
65535 строк у меня обработал за  0,73 сек.
Я сам - дурнее всякого примера! ...
 
Большое спасибо ikki и KuklP за Ваш код.
Мой код работал 13сек(с отключением экрана),а Ваши макросы работали меньше секунды,
тяжело точно было засечь,надо увеличить диапазон чисел, но и так понятно.
Страницы: 1
Читают тему
Наверх