SERGE_BLIZNUK
Silver Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
мне кажется, что целиком код кинуть Вам будет понятнее.. ;-)
Код:
Sub AddZero()
Dim i&, FirstRow&, LastRow&, p1&, p2%
Dim Cur_Cell_Type As String, s As String, sbstr As String
Dim WasChanged As Boolean
' Dim r As Range
FirstRow = ActiveWorkbook.ActiveSheet.UsedRange.Row
LastRow = FirstRow + ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count - 1
' как вариант можно пройтись только по выделенным
' For Each r In Selection
For i = FirstRow To LastRow
If Not IsEmpty(Cells(i, "A")) Then
Cur_Cell_Type = TypeName(Cells(i, "A").Value)
If (Cur_Cell_Type = "String") And (Len(Trim(Cells(i, "A").Value)) > 1) Then
s = Trim(Cells(i, "A").Value) + "-" ' временно добавим '-' в конец, потом удалим
p1 = 1
p2 = InStr(p1, s, "-")
WasChanged = False
While p2 > 0
' MsgBox "p1 = " & p1 & " substr= " & Mid(s, p1, p2 - p1)
sbstr = Mid(s, p1, p2 - p1)
If (Len(sbstr) = 1) And (val(sbstr) > 0) Then
s = Mid(s, 1, p1 - 1) & "0" & sbstr & Mid(s, p2)
p2 = p2 + 1 ' потому как строчку раздвинули на один символ!
WasChanged = True ' отметим, что мы меняли текст
End If
p1 = p2 + 1
p2 = InStr(p1, s, "-")
Wend
if inStr(1,s,"'")<>1 then s = "'" & s
If WasChanged Then Cells(i, "A").Value = Mid(s, 1, Len(s) - 1)
End If
End If
Next i
End Sub
|
|
