[ Регистрация · Вход · Новые сообщения · Участники · Правила форума · Поиск · RSS ]
  • Страница 1 из 1
  • 1
Модератор форума: irakitin2014  
Макрос замены точки на запятую
irakitin2014Дата: Пятница, 16.02.2018, 09:06 | Сообщение # 1
Генерал-майор
Группа: Модераторы
Сообщений: 312
Репутация: 6
Статус: Offline
Макрос замены точки на запятую(меняем диапазон в макросе)
Неудобство этого макроса в том,что надо менять необходимый диапазон в теле макроса( но у меня он всегда один, поэтому я не парюсь tongue )
Очень полезен при обработке данных, выгруженных из 1С

Код
Sub Макрос777()
Dim rn As Range
For Each rn In Intersect([b:e], ActiveSheet.UsedRange)
If rn Like "*#.#*" Then
rn = Val(rn) ', ".", ",")
rn.NumberFormat = "0.0000"
End If
Next
End Sub



для спасибов ЯД 41001877306852
 
irakitin2014Дата: Пятница, 16.02.2018, 10:53 | Сообщение # 2
Генерал-майор
Группа: Модераторы
Сообщений: 312
Репутация: 6
Статус: Offline
тот же макрос, но без внесения изменений в тело макроса
Выделяем диапазон, запускаем макрос
Код
Sub TTT()
    Dim rn As Range
    Dim rr As Range
    Set rr = Intersect(Selection, ActiveSheet.UsedRange)
        For Each rn In Intersect(rr, ActiveSheet.UsedRange)
            If rn Like "*#.#*" Then
                rn = Val(rn)
                rn.NumberFormat = "0.0000"
            End If
        Next
End Sub



для спасибов ЯД 41001877306852


Сообщение отредактировал irakitin2014 - Пятница, 16.02.2018, 11:11
 
dsb75Дата: Пятница, 16.02.2018, 10:59 | Сообщение # 3
Генералиссимус
Группа: Администраторы
Сообщений: 133
Репутация: 2
Статус: Offline
А зачем там комментарий после val ?
 
irakitin2014Дата: Пятница, 16.02.2018, 11:11 | Сообщение # 4
Генерал-майор
Группа: Модераторы
Сообщений: 312
Репутация: 6
Статус: Offline
не стер


для спасибов ЯД 41001877306852
 
exceliusДата: Понедельник, 18.03.2019, 17:48 | Сообщение # 5
Рядовой
Группа: Проверенные
Сообщений: 5
Репутация: 0
Статус: Offline
А зачем там пересечение с UsedRange? Да еще двойное. Можно же просто 
Код
For each rr in Selection


И еще обработку ошибок добавить
Код
on error ...




на случай, если выделен не диапазон

Upd: А! Я, кажется, понял логику. Если пользователь не обременяет себя лишними движениями мышкой и выделил сразу целый столбец. Чтож, очень даже... Ну тогда хотя бы второе пересечение давайте уберем )

Добавлено (18.03.2019, 18:53)
---------------------------------------------
Код
Sub TTT()

Dim rr As Range
Dim rn As Range

    On Error Resume Next
    Set rr = Intersect(Selection, ActiveSheet.UsedRange)
    For Each rn In rr
        If rn Like "*#.#*" Then rn = Val(rn)
    Next rn

End Sub



К сожалению, макрос не справляется с числами "100.000.00" и "100,000.00", но для них простого решения и не получится


Сообщение отредактировал excelius - Понедельник, 18.03.2019, 18:56
 
ilboxxДата: Понедельник, 07.10.2019, 15:03 | Сообщение # 6
Рядовой
Группа: Проверенные
Сообщений: 7
Репутация: 0
Статус: Offline
Отлично
 
  • Страница 1 из 1
  • 1
Поиск: