Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Check format Adresse IP

  • Initiateur de la discussion Initiateur de la discussion thombar
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

T

thombar

Guest
Bonjour cher Forum,

Je chercher un script qui après lancement puisse me dire si la valeur dans une cellule est bien dans le format d'adresse IP universellement défini.

- Respecter le format obligatoire : xxx.xxx.xxx.xxx (sachant que le nombre de x dans entre chaque "." peut varier de 1 à 3), sinon messagebox = "erreur, recommencez !"

- Si il y a des espaces dans la cellule, les supprimer.

- Si il y a un zéro devant un chiffre, le supprimer, sauf s'il est seul.
(exemple : 155.025.0.45 doit se transformer en 155.25.0.45).


Pourriez-vous m'aider ? pleeeaasse ?

merci et bon week end
 
Salut,

Si j'ai bien compris ce que tu voulais testes ceci:

Sub Princ()
Dim Res, T, I&
T = Range([A1], [A65536].End(xlUp)).Value ' à adapter
For I = 1 To UBound(T)
Res = RepZero(T(I, 1))
If Res <> False Then T(I, 1) = Res
Next I
[A1].Resize(UBound(T)) = T
End Sub

Function RepZero(ByVal Chaine$)
Dim T, I As Byte, J As Byte, Temp$
Chaine = Replace(Chaine, " ", "")
T = Split(Chaine, ".") 'à partir de XL 2000, sinon splitzon97(chaine,".")
For I = 0 To 3
If IsNumeric(T(I)) Then
While InStr(T(I), 0) >= 1 And Len(T(I)) > 1
T(I) = Replace(T(I), 0, "", 1, 1)
Wend
J = J + 1
Temp = Temp & T(I) & "."
End If
Next I
RepZero = IIf(J = 4 And UBound(T) = 3, Left(Temp, Len(Temp) - 1), False)
End Function

Au cas où tu sois sous XL97

Function SplitZon97(ByVal Ch$, Sep$)
Dim Pos&, PosS&, T(), I&
Pos = 1
Do
PosS = InStr(Pos, Ch, Sep)
ReDim Preserve T(I)
On Error Resume Next
T(I) = Mid(Ch, Pos, PosS - Pos)
If Err <> 0 Then
Pos = Pos - 1
T(I) = Right(Ch, Len(Ch) - Pos)
Exit Do
End If
Pos = PosS + 1
I = I + 1
Loop While PosS > 0
SplitZon97 = T
End Function


A+++
 
Bonjour,

Merci pour cette réponse, mais... j'ai beaucoup de mal à faire fonctionner ce code..... (Type mistmatch sur Ubound, variable non définie sur Replace, etc...), et je suis plutôt novice...

Pour être plus précis, j'ai une cellule qui doit contenir une adresse IP (exemple : A1), il faut simplement que le format soit OK selon les critères définis ci-dessus...

PS : ce serait pas mal que le code soit compatible avec toutes les versions d'Excel actuellement utilisées....

Merci de votre aide
 
Salut,

Effectivement j'avais oublié de dire que Replace n'existe pas sous XL97. Voici le code testé sous XL97 et XL2003, avec un bogue corrigé dans repzero . Tu peux aussi utilisé en fonction de feuille de calcul Repzero pour tester une cellule. ex en B1 =repzero(a1).

Sub Princ()
Dim Res, T, I&
T = Range([A1], [A65536].End(xlUp)).Value ' à adapter
For I = 1 To UBound(T)
Res = RepZero(T(I, 1))
T(I, 1) = IIf(Res <> False, Res, "Erreur")
Next I
[B1].Resize(UBound(T)) = T
End Sub

Public Function RepZero(ByVal Chaine$)
Dim T, I As Byte, J As Byte, Temp$
Chaine = ReplaceZon97(Chaine, " ", "")
T = SplitZon97(Chaine, ".")
If UBound(T) <> 3 Then RepZero = False: Exit Function
For I = 0 To 3
If IsNumeric(T(I)) Then
While InStr(T(I), 0) >= 1 And Len(T(I)) > 1
T(I) = ReplaceZon97(T(I), 0, "", 1, 1)
Wend
J = J + 1
Temp = Temp & T(I) & "."
End If
Next I
RepZero = IIf(J = 4, Left(Temp, Len(Temp) - 1), False)
End Function

Function ReplaceZon97$(ByVal Chaine$, Ch$, ChRemp$, Optional Dep& = 1, _
Optional Compte& = -1, Optional Comp As Byte = 0)
Do
Dep = InStr(Dep, Chaine, Ch, Comp)
On Error Resume Next
Chaine = Left(Chaine, Dep - 1) & ChRemp & Right(Chaine, Len(Chaine) - (Dep + Len(Ch) - 1))
On Error GoTo 0
Compte = Compte - 1
Loop While Dep > 0 And Compte <> 0
ReplaceZon97 = Chaine
End Function

Function SplitZon97(ByVal Ch$, Sep$)
Dim Pos&, PosS&, T(), I&
Pos = 1
Do
PosS = InStr(Pos, Ch, Sep)
ReDim Preserve T(I)
On Error Resume Next
T(I) = Mid(Ch, Pos, PosS - Pos)
If Err <> 0 Then
Pos = Pos - 1
T(I) = Right(Ch, Len(Ch) - Pos)
Exit Do
End If
Pos = PosS + 1
I = I + 1
Loop While PosS > 0
SplitZon97 = T
End Function

Pour ce qui est de toutes les versions, j'espère que tu n'utilises pas Excel 4 ou 7 encore...voire sous MacOS.
Si tu rencontre des difficultés à le mettre en place, joins un petit fichier exemple.

A+++
 
Merci beaucoup, mais j'ai toujours un problème, certainement une mauvaise utilisation.... (voir le fichier ci-joint).

J'ai un Type Mistmatch qui me demande de corriger la ligne :
For I = 1 To UBound(T)

Petite précision d'importance : le format est xxx.xxx.xxx.xxx sachant que chaque xxx ne peut être qu'un nombre allant de 0 à 255.

Dans l'exemple, je ne fais la vérification que sur une seule cellule, ce qui est le cas pour ma macro (pas besoin de vérifier une colonne de données)

Merci encore de ton aide Zon !
 

Pièces jointes

Bonjour à tous,

J'ai essayé de faire différemment (la façon de programmer de Zon m'est assez complexe!)
Je pense avoir tout testé, mais tu sais mieux que moi ce qui peut encore coincer.
J'ai recréé comme Zon la fonction Replace (d'une autre manière), mais j'espère que InStr est disponible sous excel 97. Sinon, dis le moi, je la reprogrammerai.

à plus…
 

Pièces jointes

Salut,

Normal que cela fonctionne pas, je ne mets pas de gestion d'erreurs pour les tests, tu n'as rien dans ta colonne A.

Moi je vois rien de complexe il suffisait juste d'adapter Princ.
Sous 97 je suis bien obligé de reécrire Split et Replace.

Tu as rajouté une condition les valeurs de 0 à 255, j'ai modifié une ligne dans repzero.

Regardes dans le fichier joint, j'ai modifié on peut le faire en évènementielle c'est à dire une fois la valeur saisie dans A1 ça se fait tout seul.

A+++
 

Pièces jointes

Génial. Ca fonctionne très bien.

Désolé, Zon, je suis un peu novice en la matière, surtout pour des codes aussi élaborés....

Me voici donc avec deux solutions à mon problème !!
Merci beaucoup pour vos efforts !
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…