Chaine$ contient-il des caractères non ASCII ?

Bonjour à toutes et tous

Je voudrais déterminer si une chaine contient des caractères hors ASCII (en l’occurrence compris entre U+0080 et U+00FF)

Bien sûr il est possible de faire une boucle caractère par caractère mais c’est très long et ma fonction doit-être d’une rapidité optimale. Verriez-vous une solution pour éviter cette boucle ? Ou à défaut une solution qui vous paraitrait optimale ?

Merci bien par avance !

bonjour,

une proposition via une boucle., cela me semble malgré tout rapide. tout dépend naturellement de la longueur de la chaine de caractères.

Function contientnonascii(t) As Boolean
    car = Chr(&H80)
    For i = 1 To Len(t)
        If Mid(t, i, 1) >= car Then
            contientnonascii = True
            Exit Function
        End If
    Next i
End Function

edit : version buggée

Bonjour,

moi j'avais ceci, vu que l'on peut boucler par paquet de 4 :

Function Test(chaine) As Boolean ' y a t il un "mauvais" caractère ?
    temp = chaine
    For i = 128 To 255 Step 4
        temp = Replace(Replace(Replace(Replace(temp, Chr(i), ""), Chr(i + 1), ""), Chr(i + 2), ""), Chr(i + 3), "")
        If Len(temp) <> Len(chaine) Then Test = True : Exit Function
    Next i
End Function

@ bientôt

LouReeD

Bonjour et grand-merci h2so4 et LouReeD,

Si vous me dites tous les deux qu’il est inévitable de faire une boucle il y a de bonnes raisons de vous croire ! Après léger remaniement de vos fonctions et comparatif chrono réitéré 500 000 fois il semblerait que la soluce h2so4 soit bien plus rapide mais l’idée de LouReeD de procéder par paquets est peut-être combinable avec celle de h2so4 ? Je vais tester.

Dans l’espoir hypothétique d’une solution meilleure que ces dernières j’attends encore un peu avant de clôturer le sujet.

@ bientôt et encore merci

Bonsoir,

après un test de curiosité, avec une itération de 100000, la fonction d'acide est 8 fois plus rapide que la mienne ! 1,2 secondes pour 8 tout rond !
Les Replace doivent être plus gourmand que le Mid !

Reste à voir si je n'en met qu'un par boucle... Je vais de ce pas essayer.

@ bientôt

LouReeD

Le plus de la fonction d'acide c'est de ne tourner que le juste nécessaire : chaine de 5 caractères, 5 rotations, de mon côté 128 !
De plus après avoir fait de façon de tourner le même nombre de fois, la fonction REPLACE combiné à celle de LEN sont cette fois ci 6 fois plus lente que le MID et le >=.

Ce n'est pas la première fois (ni la dernière) que h2so4 fourni des formules plus que rapides ! Et de mon côté ce n'est pas la première fois (ni la dernière) que je trouve une solution fonctionnelle mais dont le problème est pris à l'envers comme ici la boucle définie au lieu d'une boucle adaptée !

Le problème d'une recherche par lot ou voir même sur l'ensemble de la chaine revient à ce que j'ai proposé : il faut alors tester tous les caractères à extraire ! En faisant caractère par caractère il suffit de se limiter à ces caractères...

@ bientôt

LouReeD

Re-bonjour LouReeD,

C'est toujours très instructif de chronométrer les instructions prises individuellement dans des boucles répétées un grand nombre de fois, on se rend compte de grandes différences !

@+

bonjour,

une correction de ma fonction précédente (qui ne donnait pas toujours un résultat correct) doublée d'une optimisation de la fonction, (surtout pour le cas où la chaine ne contient pas de non ASCII)

Const lb = 128
Const lb1 = lb - 1

Type a
    s4 As String * lb
End Type
Type b
    l4(0 To lb1) As Long
End Type

Function contientnonascii4(t) As Boolean
    Dim vara As a, varb As b
    Dim car As LongLong
    car = &H80808080
    l = Len(t) Mod lb
    t = t & String(l, " ")
    For i = 1 To Len(t) Step lb
        vara.s4 = Mid(t, i, lb)
        LSet varb = vara
        For j = 0 To lb1
        r = varb.l4(j) And car
        'MsgBox vara.s4 & vbCrLf & myhex(varb.l4(j)) & " " & myhex(car) & " " & myhex(r)
        If r > 0 Then
            contientnonascii4 = True
            Exit Function
        End If
        Next j
    Next i
End Function

edit : correction bug.

Bonsoir,

Du coup là je ne comprends plus rien...

@ bientôt

LouReeD

Bonsoir Stéphane1972, LouReeD, H2so4,

Sans boucle, par l'utilisation d'un Regex qui efface les caractères de la chaîne inférieurs à 128.

Les autres restent et sont comptabilisés avec la formule Len.

Function Only(txt As String)
'Point d'exclamation jusqu'au caractére &h7F éliminés
    With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "[!-]"
   Only = Len(.Replace(txt, ""))
    End With
End Function

Edit: Apparemment certains caractères ne sont pas reconnus par le menu </>. Donc je le précise par l'image ci-dessous.

Bonjour,

tu veux juste savoir si la chine de caractères contient au moins un caractère non ASCII?

Sub test()
MsgBox IsNotASCII("A" & Chr(&H80))
End Sub
Public Function IsNotASCII(txt As String) As Boolean
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "[^\u0020-\u007F\u00C0-\u00FF]"
    IsNotASCII = .test(txt)
End With
End Function

Edite

désolé X Cellus j'étai en train de rédiger mon poste et j'ai pas vu ta réponse!

Bonsoir,

le RegExp c'est ce que j'avais vu sur le net, mais sans rien n'y comprendre du coup je n'ai rien dit...

@ bientôt

LouReeD

Bonsoir à tous,

Une fonction ressemblant comme deux gouttes d'eau à celle de H2SO4 et qui semble donner le bon résultat (on compare les codes des caractères et non les caractères) -> (A vérifier plus en avant).

Function NonAscii(ByVal x$) As Boolean
Dim c$, lg&, i&
   If x = "" Then Exit Function
   lg = Len(x)
   Do
      i = i + 1
      If Asc(Mid(x, i, 1)) > 127 Then NonAscii = True: Exit Function
   Loop Until i = lg
End Function

Le test est exécuté en 0,98 sec. sur ma bécane :

Sub test()
Dim i&, x As Boolean, deb
   deb = Timer
   For i = 1 To 1000000
      x = NonAscii("abcde" & Chr(200))
   Next i
   MsgBox Format(Timer - deb, "0.00\ sec.")
End Sub

Les méthodes avec RegEx sont très très lentes chez moi. Pour une boucle de 1 000 000, les temps d'exécution sont rédhibitoires (sup. à 9 minutes)

bonsoir le fil,

Les méthodes avec RegEx sont très très lentes chez moi. Pour une boucle de 1 000 000, les temps d'exécution sont rédhibitoires (sup. à 9 minutes)

idem chez moi.

j'ai corrigé ma version. voir mon dernier message plus haut.

de H2SO4 : j'ai corrigé ma version. voir mon dernier message plus haut.

Je n'avions point vu . Mille plus une excuses.

Et sacrément rapide cette version

Bonsoir Messieurs h2so4, LouReeD, X Cellus, dysorthographie et mafraise (ça en fait du monde !)

Petit bench avec vos fonctions :

Sub TestASCII()

Dim st!, i&, qte&, v, Texte$
Texte$ = """Ce texte moyennement long contient au moins un caracère non-ASCII"""
qte = 50000

Debug.Print "Texte= " & Texte
Debug.Print "qte= " & qte & vbCr

' h2so4
st = Timer
For i = 1 To qte
v = contientnonascii4(Texte)
Next i
Debug.Print "Solution h2so4= " & Round(Timer - st, 2) & " secondes"
Debug.Print "contientnonascii4(Texte)= " & v & vbCr

' X Cellus (modifiée)
st = Timer
For i = 1 To qte
v = Only(Texte)
Next i
Debug.Print "Solution X Cellus= " & Round(Timer - st, 2) & " secondes"
Debug.Print "Only(Texte)= " & v & vbCr

' dysorthographie
st = Timer
For i = 1 To qte
v = IsNotASCII(Texte)
Next i
Debug.Print "Solution dysorthographie= " & Round(Timer - st, 2) & " secondes"
Debug.Print "IsNotASCII(Texte)= " & v & vbCr

' mafraise
st = Timer
For i = 1 To qte
v = NonAscii(Texte)
Next i
Debug.Print "Solution mafraise= " & Round(Timer - st, 2) & " secondes"
Debug.Print "NonAscii(Texte)= " & v & vbCr
End Sub

Et résultats :

Texte= "Ce texte moyennement long contient au moins un caracère non-ASCII"

qte= 50000

Solution h2so4= 0,13 secondes

contientnonascii4(Texte)= Vrai

Solution X Cellus= 45,35 secondes

Only(Texte)= Faux

Solution dysorthographie= 45,15 secondes

IsNotASCII(Texte)= Faux

Solution mafraise= 0,31 secondes

NonAscii(Texte)= Vrai

Note : j’ai très légèrement retouché la fonction Only de X Cellus pour qu’elle renvoie un booléen et la fonction dysorthographie me renvoie un résultat : Faux alors qu’il devrait être Vrai ; les solutions utilisant le "VBScript.RegExp" semblent à priori beaucoup plus longues, mais cela reste-t-il vrai avec des chaines de grandes longueurs ?

Merci à vous cinq ! et solution du sujet signée h2so4 ! bravo !

bonjour à tous,

@mafraise

Je n'avions point vu . Mille plus une excuses.

j'accepte les excuses même si je ne comprends pas pourquoi j'aurais droit à des excuses.

Bonjour,

Impressionnant ! Je pensais qu'une solution utilisant les expressions régulières serait plus rapide qu'une boucle comme quoi

Bonjour le Fil,

@H2so4, Mafraise, Stéphane1972

Les méthodes avec RegEx sont très très lentes chez moi. Pour une boucle de 1 000 000, les temps d'exécution sont rédhibitoires (sup. à 9 minutes)

Encore faudrait-il savoir utiliser ou modifier un Regex pour ne pas divulguer des Fakes News!

@Dysorthographie, ne soit pas désolé, tous les chemins mènent à Rome. Selon X Cellus bien sur.

Impressionnant ! Je pensais qu'une solution utilisant les expressions régulières serait plus rapide

Dans l'exemple le texte fait 116 caractères dont le dernier et le 114 ième font Match.

Et dans le cas d'un texte de 255 caractères le Regex sera bien plus rapide qu'une boucle Mid.

Et ci-dessous le Regex modifié en utilisant une boucle

Sub Only()
'Point d'exclamation jusqu'au caractére &h7F éliminés
    With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "[!-]"
    Tps = Timer
    For k = 2 To 50000
   If Len(.Replace(Range("A2"), "")) > 0 Then Range("A1") = Round(Timer - Tps, 2) & " secondes": MsgBox "Trouvé": Exit Sub
   Next k
    End With
End Sub

Principe: Une fois l'objet Regex et son Pattern établi (une bonne fois pour toute). On ne boucle pas sur celui-ci, ce qui reviendrait chaque fois refaire le même moule.

On ne boucle uniquement sur le texte qui va utiliser le moule (l'objet) pour solutionner le besoin.

Imaginez un moule pour des chocolats qui va servir plusieurs fois. On ne va pas à chaque fois refaire le moule pour chaque chocolat. Sinon ceux de Noël on les aura à Pâques.

X Cellus, Après comparaison de ta fonction avec la meilleure (celle de h2so4, la deuxième) il s’avère que la tienne soit plus rapide seulement si le caractère hors ASCII est lointain dans la chaine.

Mais néanmoins je vais retenir ta solution dans le cas de manipulation de chaines longues.

Ton dernier Post est donc solution de ce sujet.

Merci beaucoup (entre autres de m’avoir fait connaitre le "VBScript.RegExp")

@+

Stéphane1972

Classeur de test h2so4 vs X Cellus avec petites modifs dans leurs codes :