Sub ss() Application.EnableEvents = False Application.ScreenUpdating = False
Dim rCell As Range, i& For Each rCell In ActiveSheet.UsedRange If rCell.Value Like "0*" Then i = Len(rCell.Value) - 1 rCell.Formula = "D" & Right(rCell.Value, i) End If Next
Application.EnableEvents = True Application.ScreenUpdating = True End Sub
[/vba]
[offtop] Сегодня день какой-то такой странный? А то все разделом промахиваются.
Пробуйте: [vba]
Код
Sub ss() Application.EnableEvents = False Application.ScreenUpdating = False
Dim rCell As Range, i& For Each rCell In ActiveSheet.UsedRange If rCell.Value Like "0*" Then i = Len(rCell.Value) - 1 rCell.Formula = "D" & Right(rCell.Value, i) End If Next
Application.EnableEvents = True Application.ScreenUpdating = True End Sub
[/vba]
[offtop] Сегодня день какой-то такой странный? А то все разделом промахиваются.SkyPro
skypro1111@gmail.com
Сообщение отредактировал SkyPro - Суббота, 14.09.2013, 16:29
SkyPro, а зачем события отключаете? Вероятно была мысль о пересчёте? Вот его возможно есть смысл отключать - но я файл не смотрел, может и нет смысла...
SkyPro, а зачем события отключаете? Вероятно была мысль о пересчёте? Вот его возможно есть смысл отключать - но я файл не смотрел, может и нет смысла...Hugo
Правильно работает код Просто вышеперечисленные строки в коде лишние. На работоспособность макроса они не влияют. enableevents - отвечает за все события на листе calculation - за пересчет формул
Правильно работает код Просто вышеперечисленные строки в коде лишние. На работоспособность макроса они не влияют. enableevents - отвечает за все события на листе calculation - за пересчет формулSkyPro
skypro1111@gmail.com
Сообщение отредактировал SkyPro - Суббота, 14.09.2013, 17:01
Еще раз огромное спасибо! Ваш код мне очень помог и поможет всем кто попадет на эту тему! С полученным документом мне надо сделать еще одну операцию. Если будет возможность загляните пожалуйста еще в новую тему.
Еще раз огромное спасибо! Ваш код мне очень помог и поможет всем кто попадет на эту тему! С полученным документом мне надо сделать еще одну операцию. Если будет возможность загляните пожалуйста еще в новую тему.BobbyJo
Думаю на практике этот код нужно подкорректировать.
Код работает именно так, как просил ТС. Но можно и подкорректировать: [vba]
Код
Sub ss() Application.ScreenUpdating = False
Dim rCell As Range, i& For Each rCell In ActiveSheet.UsedRange If rCell.Value Like "0*" And Not rCell.Value Like "0,*" Then i = Len(rCell.Value) - 1 rCell.Formula = "D" & Right(rCell.Value, i) End If Next
Application.ScreenUpdating = True End Sub
[/vba] Или так: [vba]
Код
Sub ss() Application.ScreenUpdating = False
Dim rCell As Range, i& For Each rCell In ActiveSheet.UsedRange If rCell.Value Like "0*" And IsNumeric(rCell.Value) = False Then i = Len(rCell.Value) - 1 rCell.Formula = "D" & Right(rCell.Value, i) End If Next
Думаю на практике этот код нужно подкорректировать.
Код работает именно так, как просил ТС. Но можно и подкорректировать: [vba]
Код
Sub ss() Application.ScreenUpdating = False
Dim rCell As Range, i& For Each rCell In ActiveSheet.UsedRange If rCell.Value Like "0*" And Not rCell.Value Like "0,*" Then i = Len(rCell.Value) - 1 rCell.Formula = "D" & Right(rCell.Value, i) End If Next
Application.ScreenUpdating = True End Sub
[/vba] Или так: [vba]
Код
Sub ss() Application.ScreenUpdating = False
Dim rCell As Range, i& For Each rCell In ActiveSheet.UsedRange If rCell.Value Like "0*" And IsNumeric(rCell.Value) = False Then i = Len(rCell.Value) - 1 rCell.Formula = "D" & Right(rCell.Value, i) End If Next
Претензия не к коду - претензия к заказчику Думаю BobbyJo этот аспект не продумал. Вероятно нужно заменять только в строках "заголовков", или в ячейках с нецифровым значением. Но BobbyJo виднее.
Претензия не к коду - претензия к заказчику Думаю BobbyJo этот аспект не продумал. Вероятно нужно заменять только в строках "заголовков", или в ячейках с нецифровым значением. Но BobbyJo виднее.Hugo
Ребята, как я заметил, замену надо произвести только в строке "art" столбца В. Так может и так можно: [vba]
Код
Sub Замена() For i = 1 To Range("B" & Rows.Count).End(xlUp).Row If Left(Range("A" & i), 3) = "art" And Left(Range("B" & i), 1) = "0" Then Range("B" & i).Replace What:="0", Replacement:="D" Next End Sub
[/vba]
Ребята, как я заметил, замену надо произвести только в строке "art" столбца В. Так может и так можно: [vba]
Код
Sub Замена() For i = 1 To Range("B" & Rows.Count).End(xlUp).Row If Left(Range("A" & i), 3) = "art" And Left(Range("B" & i), 1) = "0" Then Range("B" & i).Replace What:="0", Replacement:="D" Next End Sub
Ну там иногда бывает "Art*", и на практике замена кажется нужна не только в B, а случайным образом где попало. И количество строк ~13000, столбцов десяток... Но я бы тоже привязывался к "ART*" в первом столбце, и затем вправо по строке пока есть значения заменял.
Ну там иногда бывает "Art*", и на практике замена кажется нужна не только в B, а случайным образом где попало. И количество строк ~13000, столбцов десяток... Но я бы тоже привязывался к "ART*" в первом столбце, и затем вправо по строке пока есть значения заменял.Hugo
замена везде где 0 в начале ячейки. Просто FineReader распознал значок диаметра(кружок такой перечеркнутый) как 0. И в значениях где должен быть диаметр 12 например стало 012 см и т.д. Макрос SkyPro работает отлично все поправил. а где лишнее 0,1 например так это легко возвращаю заменой.
замена везде где 0 в начале ячейки. Просто FineReader распознал значок диаметра(кружок такой перечеркнутый) как 0. И в значениях где должен быть диаметр 12 например стало 012 см и т.д. Макрос SkyPro работает отлично все поправил. а где лишнее 0,1 например так это легко возвращаю заменой.BobbyJo
Сообщение отредактировал BobbyJo - Понедельник, 16.09.2013, 15:35