Страницы: 1
RSS
Заменить первую цифру после буквы
 
Привет, всем.
Есть ячейка с текстом "SVT13.03, SVT14.07", как макросом заменить первую цифру после буквы на нужную цифру - "SVT21.03, SVT24.07"?
В ячейке может быть 1 обозначение "SVT13.03", так и несколько через запятую "SVT13.03, SVT14.07, SVT14.08".

Заранее спасибо.
Изменено: vikttur - 23.06.2021 09:17:21
 
Григорий, Доброе утро, приложите файл с примером, в котором приведите несколько вариантов значений и результат который должен получиться
Изменено: msi2102 - 23.06.2021 09:18:03
 
Григорий, здравствуйте
Раз такая размытая задача, то и решение "в лоб": =ПОДСТАВИТЬ(ЯчейкаСТекстом; "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
 
Выделить диапазон для замены и запустить (шаблон несовершенен)
Изменено: Jack Famous - 23.06.2021 10:26:29
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Всем спасибо)
 
МатросНаЗебре,   В вашем макросе "Const NEW_SYMBOL = "2" ", как задать это значение ("2") формулой "h-5", где h изменяемое значение, чтобы работал макрос?
Спасибо.
 
Код
=ОБЪЕДИНИТЬ(", ";1;ПСТР(ФИЛЬТР.XML("<j><i>"&ПОДСТАВИТЬ(A2;", ";"</i><i>")&"</i></j>";"//i");1;ДЛСТР(ФИЛЬТР.XML("<j><i>"&ПОДСТАВИТЬ(A2;", ";"</i><i>")&"</i></j>";"//i"))-ДЛСТР(ПСТР(ФИЛЬТР.XML("<j><i>"&ПОДСТАВИТЬ(A2;", ";"</i><i>")&"</i></j>";"//i");МИН(ПОИСК({1;2;3;4;5;6;7;8;9;0};ФИЛЬТР.XML("<j><i>"&ПОДСТАВИТЬ(A2;", ";"</i><i>")&"</i></j>";"//i")&1234567890));9)))&ЗАМЕНИТЬ(ПСТР(ФИЛЬТР.XML("<j><i>"&ПОДСТАВИТЬ(A2;", ";"</i><i>")&"</i></j>";"//i");МИН(ПОИСК({1;2;3;4;5;6;7;8;9;0};ФИЛЬТР.XML("<j><i>"&ПОДСТАВИТЬ(A2;", ";"</i><i>")&"</i></j>";"//i")&1234567890));9);1;1;$D$1))
Изменено: Тимофеев - 12.07.2021 11:05:33
 
Код
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
Страницы: 1
Наверх