Jak převést textový řetězec na správný případ s výjimkami v aplikaci Excel?

V aplikaci Excel můžete použít funkci Správný k snadnému převodu textových řetězců na správná velikost písmen, ale někdy je třeba při převodu textových řetězců na správný případ vyloučit některá konkrétní slova, jak ukazuje následující snímek obrazovky. V tomto článku budu hovořit o několika rychlých tricích pro řešení této úlohy v aplikaci Excel.

Převeďte textové řetězce na velká a malá písmena s výjimkou pomocí vzorce

Převod textových řetězců na správné velikosti písmen s výjimkami pomocí kódu VBA

Převeďte textové řetězce na velká a malá písmena s výjimkou pomocí vzorce

Následující vzorec vám může pomoci rychle se s tímto úkolem vypořádat, postupujte takto:

Zadejte tento vzorec:

= UPPER (LEFT (A2)) & MID (TRIM (SUBSTITUTE (SUBSTITUTE (SUBSTITUTE (SUBSTITUTE ("" & PROPER (A2) & "", "Of", "of"), "A", "a"), "Is "," is ")," USA "," USA ")), 2, LEN (A2)) do buňky, kde chcete získat výsledek, a potom přetažením úchytu výplně vyplňte tento vzorec a textové řetězce byly převedeny na správný případ, ale konkrétní výjimky, viz screenshot:

Pozor: Ve výše uvedeném vzorci, A2 je buňka, kterou chcete převést, „Of“, „A“, „Is“, „Usa“ jsou normální správná velká a malá slova po převodu, „Of“, „a“, „is“, „USA“ jsou slova, která chcete vyloučit ze správného případu. Můžete je podle potřeby změnit nebo přidat další slova pomocí funkce SUBSTITUTE.

Převod textových řetězců na správné velikosti písmen s výjimkami pomocí kódu VBA

Pokud je výše uvedený vzorec poněkud obtížné pochopit a změnit podle vašich potřeb, zde můžete k dokončení tohoto úkolu použít také kód VBA. Postupně proveďte následující kroky.

1. Podržte ALT + F11 klávesy pro otevření Microsoft Visual Basic pro aplikace okno.

2, klikněte Vložit > Modula vložte následující kód do Okno modulu.

Kód VBA: převést textové řetězce na správná velikost písmen s výjimkami:

Sub CellsValueChange()
'Updateby Extendoffice
    Dim xSRg As Range
    Dim xDRg As Range
    Dim xPRg As Range
    Dim xSRgArea As Range
    Dim xRgVal As String
    Dim xAddress As String
    Dim I As Long
    Dim K As Long
    Dim KK As Long
    On Error Resume Next
    xAddress = Application.ActiveWindow.RangeSelection.Address
    Set xSRg = Application.InputBox("Original cells:", "KuTools For Excel", xAddress, , , , , 8)
    If xSRg Is Nothing Then Exit Sub
    Set xDRg = Application.InputBox("Output cells:", "KuTools For Excel", , , , , , 8)
    If xDRg Is Nothing Then Exit Sub
    Set xPRg = Application.InputBox("Cells to exclude:", "KuTools For Excel", , , , , , 8)
    If xPRg Is Nothing Then Exit Sub
    Set xDRg = xDRg(1)
    For I = 1 To xSRg.Areas.Count
        Set xSRgArea = xSRg.Areas.Item(I)
        For K = 1 To xSRgArea.Count
            xRgVal = xSRgArea(K).Value
            If Not IsNumeric(xRgVal) Then
                xRgVal = CorrectCase(xRgVal, xPRg)
                xDRg.Offset(KK).Value = xRgVal
            End If
            KK = KK + 1
        Next
    Next
End Sub
Function CorrectCase(ByVal xRgVal As String, ByVal xPRg As Range) As String
    Dim xArrWords As Variant
    Dim I As Integer
    Dim xPointer As Integer
    Dim xVal As String
    xPointer = 1
    xVal = xRgVal
    xArrWords = WordsOf(xRgVal)
    For I = 0 To UBound(xArrWords)
        xPointer = InStr(xPointer, " " & xVal, " " & xArrWords(I))
        Debug.Print xPointer
        Mid(xVal, xPointer) = CorrectCaseOneWord(CStr(xArrWords(I)), xPRg)
    Next I
    CorrectCase = xVal
End Function
Function WordsOf(xRgVal As String) As Variant
    Dim xDelimiters As Variant
    Dim xArrRtn As Variant
    xDelimiters = Array(",", ".", ";", ":", Chr(34), vbCr, vbLf)
    For Each xEachDelimiter In xDelimiters
        xRgVal = Application.WorksheetFunction.Substitute(xRgVal, xEachDelimiter, " ")
    Next xEachDelimiter
    xArrRtn = Split(Trim(xRgVal), " ")
    WordsOf = xArrRtn
End Function
Function CorrectCaseOneWord(xArrWord As String, xERg As Range) As String
    With xERg
        If IsError(Application.Match(xArrWord, .Cells, 0)) Then
            CorrectCaseOneWord = Application.Proper(xArrWord)
        Else
            CorrectCaseOneWord = Application.VLookup(xArrWord, .Cells, 1, 0)
        End If
    End With
End Function

3. Pak stiskněte tlačítko F5 klíč ke spuštění tohoto kódu a zobrazí se okno s výzvou, které vám připomene, abyste vybrali původní buňky, které chcete převést, viz screenshot:

4. A pak klikněte na tlačítko OK, ve vyskakovacím poli vyberte buňky, do kterých chcete výsledky odeslat, viz screenshot:

5. Jděte na kliknutí OKa v rozbalovacím dialogovém okně vyberte texty, které chcete vyloučit, viz screenshot:

6. A pak klikněte na tlačítko OK ukončíte dialogy a všechny textové řetězce byly převedeny na správná velikost písmen, ale vyloučte zadaná slova, viz screenshot: