如果字符串存在，則將其更改爲大寫 - 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