Як перетворити текстовий рядок у правильний регістр за винятками в Excel?

В Excel ви можете застосувати функцію належного перетворення текстових рядків у відповідний регістр, але, іноді, вам потрібно виключити деякі конкретні слова при перетворенні текстових рядків у відповідний регістр, як показано на наступному знімку екрана. У цій статті я розповім про декілька швидких прийомів для вирішення цієї роботи в Excel.

Перетворіть текстові рядки у правильний регістр за винятками, використовуючи формулу

Перетворіть текстові рядки у правильний регістр, за винятком, використовуючи код VBA

Перетворіть текстові рядки у правильний регістр за винятками, використовуючи формулу

Можливо, наступна формула може допомогти вам швидко впоратися з цим завданням, будь ласка, зробіть так:

Введіть цю формулу:

= ВЕРХНІЙ (ВЛІВО (A2)) І ПОЛІДНИЙ (ОБРІЗКА (ЗАМІНА (ЗАМІНА (ЗАМІНА (ЗАМІНА (ЗАМІНА (ЗАМІНА " "," є ")," США "," США ")), 2, LEN (A2)) у клітинку, де ви хочете отримати результат, а потім перетягніть маркер заповнення, щоб заповнити цю формулу, і текстові рядки були перетворені належним регістром, але конкретні винятки, див. знімок екрана:

Примітка:: У наведеній вище формулі, A2 це комірка, яку потрібно перетворити, “З”, “А”, “Є”, “США” є нормальними правильними регістровими словами після перетворення, “З”, “а”, “є”, “США” - це слова, які ви хочете виключити з належного регістру. Ви можете змінити їх відповідно до своїх потреб або додати інші слова за допомогою функції ЗАМІНИ.

Перетворіть текстові рядки у правильний регістр, за винятком, використовуючи код VBA

Якщо вищезазначену формулу дещо важко зрозуміти та змінити відповідно до ваших потреб, тут ви також можете застосувати код VBA для завершення цього завдання. Будь ласка, виконайте наступні кроки по одному.

1. Утримуйте клавішу ALT + F11 ключі, щоб відкрити Microsoft Visual Basic для додатків вікна.

2. Клацання Insert > Модуліта вставте наступний код у Вікно модуля.

Код VBA: перетворення текстових рядків у відповідний регістр за винятком:

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. Потім натисніть F5 клавішу для запуску цього коду, і з'явиться підказка, щоб нагадати вам вибрати вихідні комірки, які ви хочете перетворити, див. знімок екрана:

4. А потім клацніть OK, виділіть клітинки, куди ви хочете вивести результати, у спливаючому полі, див. знімок екрана:

5. Перейдіть на клацання OK, а у спливаючому діалоговому вікні виберіть тексти, які ви хочете виключити, див. знімок екрана:

6. А потім клацніть OK щоб вийти з діалогових вікон, і всі текстові рядки були перетворені у відповідний регістр, але виключають зазначені слова, див. знімок екрана: