Détecter les mots dont le 1er caractère est une lettre et les 3 suivants des nombres

coco_lapin

XLDnaute Impliqué
Bonjour le forum,

Je voudrais détecter les mots dont le premier caractère est une lettre et les 3 suivants des nombres.

J’ai réalisé la macro en annexe qui fonctionne mais qui n’est pas optimisée en terme de rapidité. Je joins aussi le classeur exemple.

Je suis preneur si vous voyez d’autres architectures.

Merci pour votre aide.

Code:
Sub essais()
Dim var1 As String
Dim var2 As String
Dim var3 As String
Dim var4 As String
Dim var5 As String

Columns(4).ClearContents
For i = 1 To 6
  Lettre = 0
  Chiffre2 = 0
  Chiffre3 = 0
  Chiffre4 = 0
  var1 = Left(Cells(i, 3), 1)
  For j = 1 To 26
    If var1 = Cells(j, 6) Then
      Lettre = 1
      Exit For
    End If
  Next j
  var2 = Right(Left(Cells(i, 3), 2), 1)
  var3 = Right(Left(Cells(i, 3), 3), 1)
  var4 = Right(Left(Cells(i, 3), 4), 1)
  For j = 1 To 9
    var5 = Cells(j, 7)
    If var2 = var5 Then
      Chiffre2 = 1
      Exit For
    End If
  Next j
  For j = 1 To 9
    var5 = Cells(j, 7)
    If var3 = var5 Then
      Chiffre3 = 1
      Exit For
    End If
  Next j
  For j = 1 To 9
    var5 = Cells(j, 7)
    If var4 = var5 Then
      Chiffre4 = 1
      Exit For
    End If
  Next j
  
  If Lettre = 1 And Chiffre2 = 1 And Chiffre3 = 1 And Chiffre4 = 1 Then
    Cells(i, 4) = "Oui"
  End If
Next i

End Sub
 

Pièces jointes

  • Test_lettre_chiffre.xls
    32 KB · Affichages: 44

youky(BJ)

XLDnaute Barbatruc
Re : Détecter les mots dont le 1er caractère est une lettre et les 3 suivants des nom

Bonjour,
Peut être comme ceci
Bruno
Code:
Sub essais()
Columns(4).ClearContents
 For i = 1 To 6
  If Not IsNumeric(Left(Cells(i, 3), 1)) And IsNumeric(Mid(Cells(i, 3), 2, 3)) Then Cells(i, 4) = "Oui"
 Next i
End Sub
 

phlaurent55

Nous a quittés en 2020
Repose en paix
Re : Détecter les mots dont le 1er caractère est une lettre et les 3 suivants des nom

Bponjour Coco-Lapin

ce code fais la même chose
Code:
Sub essais()
Columns(4).ClearContents
For i = 1 To Range("C65535").End(xlUp).Row
If Asc(Left(Cells(i, 3), 1)) > 64 And Asc(Left(Cells(i, 3), 1)) < 91 Then test = 1
For j = 2 To 4
If Asc(Mid(Cells(i, 3), j, 1)) > 47 And Asc(Mid(Cells(i, 3), j, 1)) < 58 Then
test = test + 1
End If
Next j
If test = 4 And Len(Cells(i, 3)) < 5 Then Cells(i, 4) = "OUI"
Next i
End Sub

à+
Philippe

Edit: Bonjour Youki
 

phlaurent55

Nous a quittés en 2020
Repose en paix
Re : Détecter les mots dont le 1er caractère est une lettre et les 3 suivants des nom

RE,
youky(BJ) et phlaurent55 vos codes marchent à merveille.

Merci pour votre rapidité.

Bon après-midi.


Je voudrais détecter les mots dont le premier caractère est une lettre et les 3 suivants des nombres
à noter la différence entre les 2 codes:
lorsque dans la cellule testée il y a plus de 3 chiffres derrière la lettre, mon code ne prends pas en compte cette cellule
(voir le test à l'avant-dernière ligne du code)


à+
Philippe
 

Abel

XLDnaute Accro
Re : Détecter les mots dont le 1er caractère est une lettre et les 3 suivants des nom

Bonjour le fil,

L'affaire est entendue mais je voulais juste essayer un truc pour ma culture personnelle.
Je vous le soumets donc.

A placer dans la feuille en question.
Code:
Option Explicit
Option Compare Text

Private Sub TestCaracteres()
Dim c As Range
For Each c In Range("c1:c" & [c65536].End(xlUp).Row)
If c.Value Like "[a-z]###" Then c.Offset(0, 1) = "Oui"
Next c
End Sub


Abel.
 

Modeste geedee

XLDnaute Barbatruc
Re : Détecter les mots dont le 1er caractère est une lettre et les 3 suivants des nom

Bonsour®
:rolleyes: une petite fonction personnalisée ???

Code VBA:
Function Alpha999(target)
'--------------------------strictement Alpha999
'Alpha999 = IIf(ucase(target) Like "[A-Z]###", "oui", "non")
'--------------------------commence par Alpha999
Alpha999 = IIf(UCase(target) Like "[A-Z]###*", "oui", "non")
End Function


edit : Abel m'a grillé ...
:cool: ne pas confondre : Omar m'a tué !
 
Dernière édition:

Discussions similaires

Réponses
11
Affichages
298

Statistiques des forums

Discussions
312 328
Messages
2 087 316
Membres
103 515
dernier inscrit
Cherbil12345