Excel 将字符串更改为大写（如果存在）-VBA

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

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.

---

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

这将实现以下功能：

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的讽刺言论。如果您要查找的是

道路？

其中

？

是字母

a-z

，那么让

像
一样查找
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"

这是另一种方法。让Excel来做脏活；）

也可以使用.FIND/.FINDNEXT代替循环

有关“查找/查找下一个”的详细信息：

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”中处理：）

后续（如果用户是这么想的）

你可能没有抓住重点。。。OP不仅在寻找roadh，还寻找任何道路？哪里是一个字母a-z。你必须弄清楚是什么？是，并使其大写。这就是这个问题（稍微）有趣的转折点让·弗朗索瓦·科贝特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

子样本（）
暗橙色作为范围，aCell作为范围，bCell作为范围
将ws设置为工作表
Dim ExitLoop作为布尔值
Dim SearchString作为字符串，FoundAt作为字符串
关于错误转到哇
设置ws=工作表（“表1”）
设置oRange=ws.Columns（1）
SearchString=“道路”
设置aCell=oRange.Find（What:=SearchString&“？”，LookIn:=xlValues_
查看：=xlPart，搜索顺序：=xlByRows，搜索方向：=xlNext_
MatchCase:=False，SearchFormat:=False）
如果不是的话，亚塞尔什么都不是
设置bCell=aCell
FoundAt=aCell.Address
aCell.Value=repl（aCell.Value，SearchString）
当ExitLoop=False时执行
设置aCell=oRange.FindNext（后面：=aCell）
如果不是的话，亚塞尔什么都不是
如果aCell.Address=bCell.Address，则退出Do
FoundAt=FoundAt&“，”和aCell.Address
aCell.Value=repl（aCell.Value，SearchString）
其他的
ExitLoop=True
如果结束
环
MsgBox“已在以下位置找到搜索字符串：&FoundAt&”，并替换为大写”
其他的
MsgBox SearchString&“未找到”
如果结束
出口接头
哇
MsgBox错误说明
端接头
函数repl（cellValue作为字符串，srchString作为字符串）作为字符串
作为整数的Dim pos
pos=InStr（1，单元格值，srchString，vbTextCompare）
repl=cellValue
在pos 0时执行此操作
如果pos=1，则
repl=UCase（左（repl，Len（srchString）+1）和中（repl，Len（srchString）+2）
其他的
repl=Mid（repl，1，pos-1）和UCase（Mid（repl，pos，Len（srchString）+1））&_
中间（repl，pos+Len（srchString）+1）
如果结束
调试.Print repl
pos=InStr（pos+1，repl，srchString，vbTextCompare）
环
端函数

快照：


嗯

Sid
带有regexp的way，替换输入中的所有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

你是在一个
If
语句中测试整个字母表吗？小心，这很容易在每天的WTF上结束…@minitech是的，我是。是的，我完全知道这不是正确的方法，但我只是想知道如果我有一个条件，这是否可行。你可以使用
像“*road[a-z]*”
…更快+1。我特别喜欢road的Const。更改搜索的字符串太容易了，而忘记了更改字符串的长度。我在工具库中创建了一个前缀来处理这种类型的搜索。+1用于查看我看不到的内容。例如，如果作者实际上是指尚不清楚的内容：）你可能没有抓住重点。。。OP不仅要查找
道路
，还要查找任何
道路
，其中
？
是字母
a-z
。你必须弄清楚什么是
？
，并将其大写。这是这个问题（稍微）有趣的转折。@Jean-François Corbett:你可能是对的JCM:）。我重读了这个问题，这个问题根本不是你刚才暗示的意思。还是我错过了你能看到的东西？这就是作者所说的“A1单元由“roadhouse blues”组成。我只希望“roadh”在该单元中存在时改为大写。”好吧，不要厚颜无耻，请再读一遍：OP说示例：A1单元由“roadhouse blues”组成。
roadhouse blues
中的“
roadh
”只是一个例子，不能代表OP的总体需求。请看示例前面写的内容。代码片段清楚地表明OP不仅仅是在寻找
roadh
（这也隐含在问题的注释中）。当然，OP对此并不十分清楚。@Jean-François Corbett:嗯，我明白你的推断。添加额外的代码来考虑这一点。还添加和额外检查（如果牢房有“roadhouse blues roadrent”怎么办？@Jean-François Corbett:你不必这么做。但谢谢你的好意：）
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