Décapage Majuscules mots dans Excel VBA

Question

Décapage Majuscules mots dans Excel VBA

j'ai une feuille Excel comme celui-ci:

 
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 

Je veux extraire tous les mots MAJUSCULES et générer une liste les:

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

Je pensais que je pouvais vérifier si « eachWord » == UCase (eachWord), mais je ne sais pas comment gérer des phrases. Je ne sais pas non plus comment gérer les phrases qui se terminent par "apostrophe s", "fin parenthèse", ou ponctuation.

Je suis mots fendage comme ceci: IndividualWordsArray = Split(ActiveSheet.Cells(workingRow, 2).Value)

Mais cela ne fait que un tableau basé sur les caractères de l'espace. Je pensais que cela pourrait aider si, en plus des espaces, il pouvait aussi se séparer de ces caractères: "(): ',. ? ! ; Après quelques recherches, je trouve que je peux séparer une ligne par un autre que des espaces, mais seulement un délimiteur à la fois.

Quelqu'un at-il une idée de comment créer une liste avec tous les mots et expressions majuscules?

Answer 1

Un moyen simple est de prendre une copie de votre texte, remplacer tous les caractères délimiteurs par un espace, puis diviser en utilisant un espace comme délimiteur.

Answer 2

Voici une manière lente laide, mais cela fonctionne (sauf qu'il ne retournera pas NET à partir de NET). Je fais juste une boucle dans le tableau des mots et je teste chaque lettre pour les caps. La déclaration Option Compare Binary est cruciale.

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