如果存在，则将字符串更改为大写 - VBA

Change a String to Uppercase if it Exists - VBA

提问by user823911

How do I change a particular string to Uppercase only if it exists.

如何仅在特定字符串存在时将其更改为大写。

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.

Each cell contains two or more words. Example: Cell A1 consists of "roadhouse blues". I want only 'roadh' to change to Uppercase if it exists in that cell. Is this possible in VBA?

每个单元格包含两个或多个单词。示例：单元格 A1 由“roadhouse blues”组成。如果它存在于该单元格中，我只想将“roadh”更改为大写。这在VBA中可能吗？

回答by Jean-Fran?ois Corbett

This will do the trick:

这将解决问题：

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.

---

---

If I were you, I would heed @minitech's sarcastic remark. If what you're looking for is road?where ?is a letter a-zthen let Likelook for a-zrather than manually typing the entire alphabet...

如果我是你，我会留意@minitech 的讽刺言论。如果您要查找的是字母road?在哪里，那么让我们查找而不是手动输入整个字母表...?a-zLikea-z

Here is how I would do it:

这是我将如何做到的：

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"

回答by Siddharth Rout

Here is another way. Let Excel do the dirty work ;)

这是另一种方式。让 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

Also instead of looping you might want to use .FIND/.FINDNEXT ?

另外，您可能想使用 .FIND/.FINDNEXT 而不是循环？

More on 'Find/FindNext': http://www.siddharthrout.com/index.php/2018/01/05/find-and-findnext-in-excel-vba/

有关“查找/查找下一个”的更多信息：http: //www.siddharthrout.com/index.php/2018/01/05/find-and-findnext-in-excel-vba/

FIND/FINDNEXT is far much more faster then looping and searching for values in Excel Cells ;)

FIND/FINDNEXT 比在 Excel 单元格中循环和搜索值要快得多；)

AND the below is even faster (in fact the fastest). You don't need to find the word if your final intention is to replace the word. Simply issue the replacecommand. If the code finds any word then it will automatically 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

You don't need to use the wildcard character to check for the presence of a string inside a string. xlPartin "LookAt:=xlPart" takes care of that :)

您不需要使用通配符来检查字符串中是否存在字符串。xlPart在“注视：= xlPart”需要的是照顾:)

FOLLOWUP(In Case the user meant this)

跟进（如果用户是这个意思）

You may be missing the point here... OP is not only looking for roadh but for any road? where ? is a letter a-z. You have to figure out what ? is and make it uppercase. That's the (mildly) interesting twist of this problem. – Jean-Fran?ois Corbett 1 hour ago

您可能在这里错过了重点...... OP 不仅在寻找道路，而且在寻找任何道路？在哪里 ？是一个字母az。你必须弄清楚什么？是并使其大写。这是这个问题的（轻微）有趣的转折。– Jean-Fran?ois Corbett 1 小时前

Also checking for the scenario where the cell can contain multiple "road" values (as shown in snapshot below which has a 'before' and 'after' snapshot.

还检查单元格可以包含多个“道路”值的场景（如下面的快照所示，其中包含“之前”和“之后”快照。

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:

快照：

HTH

HTH

Sid

锡德

回答by Alex K.

A way with a regexp, replaces all Road* in the input.

一种带有正则表达式的方式，替换输入中的所有 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