Измените строку на заглавную, если она существует - VBA

Question

Как изменить конкретную строку на заглавную, только если она существует.

If (Cells(i, "A") Like "*roada*") Or (Cells(i, "A") Like "*roadb*") _
Or (Cells(i, "A") Like "*roadc*") etc... Then 'Change only the found string to Uppercase.

Каждая ячейка содержит два или более слов.Пример: ячейка А1 состоит из "дорожного блюза".Я хочу, чтобы только значение 'roadh' изменилось на Uppercase, если он существует в этой ячейке.Возможно ли это в VBA?

Answer 1

Вот другой способ. Пусть Excel сделает грязную работу;)

Sub Sample()
    Dim SearchString As String
    Dim ReplaceString As String
    Dim aCell As Range

    '~~> Search String
    SearchString = "roadh"
    '~~> Replace string
    ReplaceString = UCase(SearchString)

    '~~> Change A1 to to the respective cell
    Set aCell = Range("A1").Find(What:=SearchString, LookIn:=xlFormulas, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False)

    '~~> If Found
    If Not aCell Is Nothing Then
        Range("A1").Replace What:=SearchString, Replacement:=ReplaceString, _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    End If
End Sub

Также вместо цикла вы можете использовать .FIND / .FINDNEXT?

Подробнее о 'Find / FindNext' : http://www.siddharthrout.com/index.php/2018/01/05/find-and-findnext-in-excel-vba/

FIND / FINDNEXT намного быстрее, чем зацикливание и поиск значений в ячейках Excel;)

И ниже даже быстрее ( на самом деле самый быстрый ). Вам не нужно искать слово, если вы хотите заменить слово. Просто введите команду replace . Если код находит какое-либо слово, оно автоматически заменяется.

Sub Sample()
    Dim SearchString As String
    Dim ReplaceString As String

    '~~> Search String
    SearchString = "roadh"
    '~~> Replace string
    ReplaceString = UCase(SearchString)

    '~~> Replace the range below with the respective range
    Range("A1:A1000").Replace What:=SearchString, Replacement:=ReplaceString, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
End Sub

Вам не нужно использовать подстановочный знак для проверки наличия строки внутри строки. xlPart в " LookAt: = xlPart " позаботится об этом:)

FOLLOWUP (В случае, если пользователь имел в виду это)

Возможно, вы упускаете суть здесь ... ОП ищет не только дорогу, но и любую дорогу? где ? это буква а-я. Вы должны выяснить, что? и сделать его прописными. Это (мягко) интересный поворот этой проблемы. - Жан-Франсуа Корбетт 1 час назад

Также выполняется проверка сценария, в котором ячейка может содержать несколько значений «дороги» (как показано на снимке ниже, который имеет снимок «до» и «после».

Sub Sample()
    Dim oRange As Range, aCell As Range, bCell As Range
    Dim ws As Worksheet
    Dim ExitLoop As Boolean
    Dim SearchString As String, FoundAt As String

    On Error GoTo Whoa

    Set ws = Worksheets("Sheet1")
    Set oRange = ws.Columns(1)

    SearchString = "road"

    Set aCell = oRange.Find(What:=SearchString & "?", LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

    If Not aCell Is Nothing Then
        Set bCell = aCell

        FoundAt = aCell.Address

        aCell.Value = repl(aCell.Value, SearchString)

        Do While ExitLoop = False
            Set aCell = oRange.FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do

                FoundAt = FoundAt & ", " & aCell.Address

                aCell.Value = repl(aCell.Value, SearchString)
            Else
                ExitLoop = True
            End If
        Loop

        MsgBox "The Search String has been found these locations: " & FoundAt & " and replaced by UPPERCASE"

    Else
        MsgBox SearchString & " not Found"
    End If

    Exit Sub
Whoa:
    MsgBox Err.Description
End Sub

Function repl(cellValue As String, srchString As String) As String
    Dim pos As Integer

    pos = InStr(1, cellValue, srchString, vbTextCompare)
    repl = cellValue
    Do While pos <> 0
        If pos = 1 Then
            repl = UCase(Left(repl, Len(srchString) + 1)) & Mid(repl, Len(srchString) + 2)
        Else
            repl = Mid(repl, 1, pos - 1) & UCase(Mid(repl, pos, Len(srchString) + 1)) & _
            Mid(repl, pos + Len(srchString) + 1)
        End If
        Debug.Print repl

        pos = InStr(pos + 1, repl, srchString, vbTextCompare)
    Loop
End Function

Snapshot

* * НТН тысяче сорок-девять

Sid

Answer 2

Это поможет:

Const road As String = "road"

Dim s As String
Dim letterAfterRoad As String

s = "play that roadhouse blues" ' or get contents of some cell
letterAfterRoad = Mid(s, InStr(s, road) + Len(road), 1)
Mid(s, InStr(s, road)) = UCase(road & letterAfterRoad)

Debug.Print s ' returns "play that ROADHouse blues". Write to cell.

---

На вашем месте я бы прислушался к саркастическому замечанию @ minitech. Если вы ищете road?, где ? - это буква a-z, тогда позвольте Like искать a-z, а не вводить вручную весь алфавит ...

Вот как бы я это сделал:

Const road As String = "road"

Dim s As String
Dim charAfterRoad As String
Dim roadPos As Long

s = "play that roadhouse blues"

roadPos = InStr(s, road)
If roadPos > 0 And Len(s) >= roadPos + Len(road) Then
    'Found "road" and there is at least one char after it.
    charAfterRoad = Mid(s, roadPos + Len(road), 1)
    If charAfterRoad Like "[a-z]" Then
        Mid(s, InStr(s, road)) = UCase(road & charAfterRoad)
    End If
End If

Debug.Print s ' returns "play that ROADHouse blues"

Answer 3

Способ с регулярным выражением, заменяет все Road * на входе.

Sub repl(value As String)
    Dim re As Object: Set re = CreateObject("vbscript.regexp")
    Dim matches As Object, i As Long
    re.IgnoreCase = True
    re.Global = True
    re.Pattern = "(road[A-Z])"
    Set matches = re.Execute(value)
    For i = 0 To matches.Count - 1
        value = Replace$(value, matches(i), UCase$(matches(i)))
    Next
    Debug.Print value
End Sub