Удаление прописных слов в Excel VBA

Question

Удаление прописных слов в Excel VBA

У меня есть лист Excel, подобный этому:

A        B
1        Used CONTENT VERSION SYSTEM for the FALCON Project
2        USA beats UK at Soccer Cup 2008
3        DARPA NET’s biggest contribution was the internet
4        One big problem is STRUCTURED QUERY LANGUAGE queries on non-normalized data

Я хочу извлечь все слова в верхнем регистре и создать список из них:

A                             B
CONTENT VERSION SYSTEM        1
FALCON                        1
USA                           2
UK                            2
DARPA NET                     3
STRUCTURED QUERY LANGUAGE     4

Я думал, что смогу проверить, если «eachWord» == UCase (eachWord), но я не знаю, как обрабатывать фразы. Я также не знаю, как обращаться с фразами, оканчивающимися на «апостроф», «конец скобок» или пунктуацию.

Я разделяю слова вроде этого: IndividualWordsArray = Split(ActiveSheet.Cells(workingRow, 2).Value)

Но это только делает массив основанный на пробелах. Я подумал, что это могло бы помочь, если бы, кроме пробелов, он мог также разделиться на следующие символы: «():‘,. ? ! ; После некоторых поисков я могу разделить строку символом, отличным от пробелов, но только по одному разделителю за раз.

Кто-нибудь знает, как создать список со всеми прописными словами и фразами?

Answer 1

Один простой способ - взять копию текста, заменить все символы разделителя пробелом, а затем разделить, используя пробел в качестве разделителя.

Answer 2

Вот ужасно медленный путь, но он работает (за исключением того, что он не вернет NET из NET). Я просто перебираю массив слов и проверяю каждую букву на заглавные буквы. Option Compare Binary утверждение имеет решающее значение.

Option Explicit
Option Compare Binary

Sub x()
    Dim IndividualWordsArray() As String, keeperArray() As String
    Dim i As Integer, j As Integer, k As Integer
    Dim allCaps As Boolean

    IndividualWordsArray = Split(ActiveCell)
    k = 0
    For i = 0 To UBound(IndividualWordsArray)
        allCaps = True
        For j = 1 To Len(IndividualWordsArray(i))
            If Not Mid(IndividualWordsArray(i), j, 1) Like "[A-Z]" Then
                allCaps = False
                Exit For
            End If
        Next j
        If allCaps Then
            ReDim Preserve keeperArray(k)
            keeperArray(k) = IndividualWordsArray(i)
            Debug.Print keeperArray(k)
            k = k + 1
        End If
    Next i
End Sub