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.

每个单元格包含两个或更多单词。示例：Cell A1由“roadhouse blues”组成。我希望只有'roadh'才能更改为大写，如果它存在于该单元格中。这在VBA中是否可行？

Answer 1

这样可以解决问题：

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 2

这是另一种方式。让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单元格中循环和搜索值要快得多;）

以下更快（实际上是最快的）。如果你的最终目的是替换这个词，你不需要找到这个词。只需发出替换命令即可。如果代码找到任何单词，那么它将自动替换。

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

您不需要使用通配符来检查字符串中是否存在字符串。 “ LookAt：= xlPart ”中的 xlPart 可以解决这个问题：）

关注（如果用户是这样的话）

你可能在这里忽略了这一点...... OP不只是寻找路，而是寻找任何道路？哪里？是一个字母a-z。你必须搞清楚什么？是，并使其大写。这是这个问题的（温和）有趣的转折。 - Jean-FrançoisCorbett1小时前

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

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

<强>快照：

enter image description here

HTH

西特

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

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

3 个答案: