Перейти до основного матеріалу

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

Найкращі інструменти продуктивності офісу

🤖 Kutools AI Aide: Революціонізуйте аналіз даних на основі: Інтелектуальне виконання   |  Згенерувати код  |  Створення спеціальних формул  |  Аналізуйте дані та створюйте діаграми  |  Викликати функції Kutools...
Популярні функції: Знайдіть, виділіть або визначте дублікати   |  Видалити порожні рядки   |  Об’єднайте стовпці або клітинки без втрати даних   |   Раунд без Формули ...
Супер пошук: VLookup за кількома критеріями    Багатозначний VLookup  |   VLookup на кількох аркушах   |   Нечіткий пошук ....
Розширений розкривний список: Швидке створення випадаючого списку   |  Залежний спадний список   |  Виберіть розкривний список, що вибирається ....
Менеджер колонок: Додайте конкретну кількість стовпців  |  Перемістити стовпці  |  Перемкнути статус видимості прихованих стовпців  |  Порівняйте діапазони та стовпці ...
Особливості: Фокус сітки   |  Перегляд дизайну   |   Велика панель формул    Диспетчер робочих книг і аркушів   |  Бібліотека ресурсів (автотекст)   |  Вибір дати   |  Об’єднайте робочі аркуші   |  Шифрування/розшифрування клітинок    Надсилайте листи за списком   |  Супер фільтр   |   Спеціальний фільтр (фільтр жирний/курсив/закреслений...) ...
Топ-15 наборів інструментів12 текст Tools (додати текст, Видалити символи, ...)   |   50 + Графік типи (діаграма Ганта, ...)   |   40+ Практичний Формули (Розрахуйте вік на основі дня народження, ...)   |   19 вставка Tools (Вставте QR-код, Вставити зображення зі шляху, ...)   |   12 Перетворення Tools (Числа до слів, Валютна конверсія, ...)   |   7 Злиття та розділення Tools (Розширені комбіновані ряди, Розділені клітини, ...)   |   ... і більше

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

Опис


Вкладка Office Передає інтерфейс із вкладками в Office і значно полегшує вашу роботу

  • Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
  • Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
  • Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!
Comments (1)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
This would be amazing if only the Macro excluded the part of the sting in CAPS not the entire cell from the exceptions list.
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations