Привет, всем. Есть ячейка с текстом "SVT13.03, SVT14.07", как макросом заменить первую цифру после буквы на нужную цифру - "SVT21.03, SVT24.07"? В ячейке может быть 1 обозначение "SVT13.03", так и несколько через запятую "SVT13.03, SVT14.07, SVT14.08".
Григорий, здравствуйте Раз такая размытая задача, то и решение "в лоб": =ПОДСТАВИТЬ(ЯчейкаСТекстом; "SVT13"; "SVT21") — написать столько таких условий, сколько замен нужно произвести
P.S.: различайте ЦИФРЫ (0-9) и ЧИСЛА (состоят из цифр)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Файл во вложении, мне нужен макрос универсальный для всех случаев данный в примере (если перед цифрой есть буква, то цифру заменить на нужную в ячейке).
Option Explicit
Const NEW_SYMBOL = "2"
Sub ReplaceInSelection()
Dim r As Range
On Error Resume Next
Set r = Selection.SpecialCells(xlCellTypeConstants)
On Error GoTo 0
ReplaceInRange r
End Sub
Sub ReplaceInRange(r As Range)
Dim vArea As Range
Dim arr As Variant
Dim y As Long
Dim x As Integer
Dim s As String
For Each vArea In r.Areas
If vArea.Cells.Count = 1 Then
ReDim arr(1 To 1, 1 To 1)
arr(1, 1) = vArea.Value
Else
arr = vArea
End If
For y = 1 To UBound(arr, 1)
For x = 1 To UBound(arr, 2)
s = arr(y, x)
ReplaceString s
arr(y, x) = s
Next
Next
vArea = arr
Next
End Sub
Sub ReplaceString(s As String)
Dim i As Long
Dim iAsc As Long
Dim c As String
Dim t As String
Dim f As Boolean
If Len(s) > 1 Then
t = Mid(s, 1, 1)
For i = 2 To Len(s)
f = False
c = Mid(s, i, 1)
If IsNumeric(c) Then
iAsc = Asc(LCase(Mid(s, i - 1, 1)))
If iAsc >= 97 And iAsc <= 122 Then f = True 'английские буквы
If f = False Then If iAsc >= 224 And iAsc <= 255 Then f = True 'русские буквы
End If
If f Then
t = t & NEW_SYMBOL
Else
t = t & c
End If
Next
s = t
End If
End Sub
Выделить диапазон для замены и запустить (шаблон несовершенен)
Код
Option Explicit
'====================================================================================================
Sub Replacer()
Dim RE As New RegExp ' Dim RE as Object: Set RE = CreateObject("VBScript.RegExp") - если библиотека не подключена (в файле она подключена)
Dim rng As Range, cl As Range, txF$
Const txR$ = "2"
Set rng = Selection
RE.Pattern = "([A-Za-zЁёА-я])(\d)": RE.Global = True
For Each cl In rng
txF = cl.Value2
If RE.Test(txF) Then cl.Value2 = RE.Replace(txF, "$1" & txR)
Next cl
End Sub
'====================================================================================================
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
МатросНаЗебре, В вашем макросе "Const NEW_SYMBOL = "2" ", как задать это значение ("2") формулой "h-5", где h изменяемое значение, чтобы работал макрос? Спасибо.
Option Explicit
'Const NEW_SYMBOL = "2"
Sub ReplaceInSelection()
Dim r As Range
On Error Resume Next
Set r = Selection.SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If Not r Is Nothing Then
Dim NEW_SYMBOL As String
NEW_SYMBOL = InputBox("Введите h", "NEW_SYMBOL")
If NEW_SYMBOL <> "" Then
If IsNumeric(NEW_SYMBOL) Then
Dim h As Long
h = NEW_SYMBOL
NEW_SYMBOL = h - 5
End If
ReplaceInRange r, NEW_SYMBOL
End If
End If
End Sub
Sub ReplaceInRange(r As Range, NEW_SYMBOL As String)
Dim Application_Calculation As Long
Application_Calculation = Application.Calculation
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim vArea As Range
Dim arr As Variant
Dim y As Long
Dim x As Integer
Dim s As String
For Each vArea In r.Areas
If vArea.Cells.Count = 1 Then
ReDim arr(1 To 1, 1 To 1)
arr(1, 1) = vArea.Value
Else
arr = vArea
End If
For y = 1 To UBound(arr, 1)
For x = 1 To UBound(arr, 2)
s = arr(y, x)
ReplaceString s, NEW_SYMBOL
arr(y, x) = s
Next
Next
vArea = arr
Next
Application.EnableEvents = True
Application.Calculation = Application_Calculation
Application.ScreenUpdating = True
End Sub
Sub ReplaceString(s As String, NEW_SYMBOL As String)
Dim i As Long
Dim iAsc As Long
Dim c As String
Dim t As String
Dim f As Boolean
If Len(s) > 1 Then
t = Mid(s, 1, 1)
For i = 2 To Len(s)
f = False
c = Mid(s, i, 1)
If IsNumeric(c) Then
iAsc = Asc(LCase(Mid(s, i - 1, 1)))
If iAsc >= 97 And iAsc <= 122 Then f = True 'английские буквы
If f = False Then If iAsc >= 224 And iAsc <= 255 Then f = True 'русские буквы
End If
If f Then
t = t & NEW_SYMBOL
Else
t = t & c
End If
Next
s = t
End If
End Sub
как макросом заменить первую цифру после буквы на нужную цифру
UDF замена на 2
Код
Function iDigit(cell$)
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "([A-Z]{1,})(\d)"
If .test(cell) Then
iDigit = .Replace(cell, "$12")
Else
iDigit = ""
End If
End With
End Function