如果字符串存在，则将其更改为大写 - 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. 

每个单元包含两个或更多单词。示例：单元格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？

更多关于 '查找/ FindNext中'：http://siddharthrout.wordpress.com/2011/07/14/find-and-findnext-in-excel-vba/

查找/ 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 

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

随访（万一用户意味着这个）

您可以在这里失去了点...... OP不仅在寻找道路，而且在任何道路上寻找道路？在哪里？是一个字母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 

快照：

HTH

希德

Answer 3

用正则表达式的一种方式，替换所有路*输入。

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