Après l’import d’un fichier Excel dans une table Access, on souhaitait regrouper et compter les sous-chaînes d’une colonne par une requête SQL.
On part donc de :
…pour arriver à :
Générer la table et ses lignes
Cette fontion génère la table tTransposition qui est peuplée de 10 000 lignes de textes aléatoires.
Pour l’utiliser, copier l’ensemble du code dans un module VBA, placer le focus dans la fonction ‘CreationTableTransposition()’ puis appuyer sur ‘F5‘ pour l’exécuter.
With DoCmd
.SetWarnings False
.RunSQL "CREATE TABLE tTransposition (Texte VARCHAR NOT NULL);"
.SetWarnings True
End With
GenereTranspositionTextes
MsgBox "Création terminée"
End Function
Private Function GenereTranspositionTextes()
Const clMaxLignes As Long = 10000
Dim odb As DAO.Database
Dim ors As DAO.Recordset
Dim Texte As String
Dim i As Long, j As Long, n As Long
Set odb = CurrentDb
Set ors = odb.OpenRecordset("tTransposition", dbOpenDynaset)
Randomize
With ors
For i = 1 To clMaxLignes
'construction du texte
n = Int(Rnd() * 9) 'nombre de separateurs
If n > 0 Then
Texte = ""
For j = 1 To n
Texte = Texte & String$(j, 49 + j - 1) & "@"
Next j
Texte = Left$(Texte, Len(Texte) - 1)
Else
j = Int(Rnd() * 9) + 1
Texte = String$(j, 49 + j - 1)
End If
'Ajout de la ligne
.AddNew
!Texte = Texte
.Update
Next i
.Close
End With
Set ors = Nothing
Set odb = Nothing
End Function
La trousse à outils VBA
Pour chaque ligne de la table, il faudra compter les occurrences du séparateur « @ », déterminer ainsi le nombre de sous-chaînes (nombre de séparateurs + 1) qui seront enfin séparées et extraites.
Par chance, on a déjà présenté dans ce blog deux fonctions personnelles qui remplissent ces tâches :
If Texte vbNullString Then CompteOccurrences = UBound(Split(Texte, Chaine, -1, TypeComparaison))
End Function
et
'Retourne le token spécifié par son numéro
'Auteur : Philben - v1.01
'Exemple : Token("a-b-c","-",2) -> b
Dim Tok As String
Dim x As Long, y As Long
Select Case Numero
Case Is > 1
x = InStr(1, Replace(Texte, Separateur, vbNullString, 1, Numero - 2, TypeComparaison), Separateur, TypeComparaison)
If x > 0 Then
x = x + Len(Separateur) * (Numero - 1)
y = InStr(x, Texte, Separateur, TypeComparaison)
If y > 0 Then
Tok = Mid$(Texte, x, y - x)
Else
Tok = Mid$(Texte, x)
End If
End If
Case 1
x = InStr(1, Texte, Separateur, TypeComparaison)
If x > 0 Then
Tok = Left$(Texte, x - 1)
Else
Tok = Texte
End If
Case -1
x = InStrRev(Texte, Separateur, -1, TypeComparaison)
If x > 0 Then
Tok = Mid$(Texte, x + Len(Separateur))
Else
Tok = Texte
End If
End Select
Token = Tok
End Function
Comment créer des lignes qui n’existent pas ?
En effet, la colonne contient entre une et huit sous-chaînes selon la ligne. Comment générer une ligne par sous-chaîne à partir d’une ligne source dans la requête SQL ?
Pour ce faire, on s’appuie sur le fait qu’une relation 1-n entre deux tables génère n lignes dans une requête.
Connaissant le nombre de sous-chaîne, il nous faut donc créer une table de chiffres que l’on mettra en relation avec ce nombre pour générer les lignes.
Cette fonction créée pour vous la table tChiffres et ajoute une ligne par chiffre (0 à 9)
Const cInsert As String = "INSERT INTO tChiffres (Chiffre) VALUES "
Dim i As Long
With DoCmd
.SetWarnings False
.RunSQL "CREATE TABLE tChiffres (Chiffre LONG CONSTRAINT PrimaryKey PRIMARY KEY);"
For i = 0 To 9
.RunSQL cInsert & "(" & i & ")"
Next i
.SetWarnings True
End With
MsgBox "Création terminée de la table "
End Function
Par exemple, la requête SQL suivante génére tous les nombres entre 0 et 999 :
FROM tchiffres C1,
tchiffres C2,
tchiffres C3
Dans notre cas, nous avons au maximum 8 sous-chaînes, donc la première partie de notre requête s’écrira :
Ceci permettra d’associer un chiffre à chaque sous-chaîne extraite.
Extraire les sous-chaînes
La fonction Token(…) a pour argument le numéro (1 à x) de la sous-chaîne à extraire. Il faut donc ajouter 1 aux chiffres retournés par la relation précédente.
La clause FROM de notre requête est maintenant formée :
Requête finale
Finalement, on réalise un regroupement sur les chaînes et un comptage décroissant :
COUNT(*) AS Compte
FROM (SELECT Token(texte, "@", chiffre + 1) AS Chaine
FROM (
SELECT texte,
Compteoccurrences(texte, "@") + 1 AS Compte
FROM ttransposition
) AS T
INNER JOIN tchiffres AS C
ON T.compte > C.chiffre
) AS R
GROUP BY R.chaine
ORDER BY COUNT(*) DESC;
Pour ne pas plomber la vitesse d’exécution de la requête, l’enregistrer, quitter l’application Access, la redémarrer puis lancer la requête SQL sans ouvrir auparavant l’éditeur VBA.
En moins de 2 secondes, le résultat de la requête devrait s’afficher.
A noter que le texte des lignes est généré aléatoirement d’où certainement des écarts entre les comptages de la capture d’écran et les vôtres.
Requête SQL sans UDF
Si le coeur vous en dit, la requête suivante réalise le même travail sans utiliser une fonction personnelle.
Mis à part les fonctions VBA déjà décrites dans ce blog, on utilise la fonction StrReverse() pour supprimer les séparateurs postérieurs à la sous-chaîne à extraire et déterminer ainsi sa longueur.
COUNT(*) AS Compte
FROM (
SELECT IIf(Num>1 AND NUM1, LEFT$(T.Texte,InStr(1,T.Texte,"@",0)-1),T.Texte),
MID$(T.Texte,InStrRev(T.Texte,"@",-1,0)+1))) AS Chaine,
Chiffre+1 AS Num
FROM (
SELECT Texte,
Len(Texte) - Len(REPLACE(Texte,"@","",1,-1,0))+1 AS Compte
FROM tTransposition
) AS T
INNER JOIN tChiffres AS C
ON T.Compte>C.Chiffre
) AS R
GROUP BY R.Chaine
ORDER BY COUNT(*) DESC;
Lien
Voir ce billet pour réaliser une transposition inverse.
@+
Philippe