XL 2016 extraction code postal vba

sri75 · 30 Juin 2022

Bonjour à tous, je bloque sur l'extraction en vba des deux premiers chiffres du code postal.

j'ai tenté left mais pour les codes postaux commençant par un zéro comme dans mon fichier ca me renvoie les deuxièmes et troisièmes caractères ( ex 01230 ca renvoie 12 ).

j'ai forcé le format 00000 ou code postal rien n'y fait Selection.NumberFormat = "00000" puis
toto = ActiveCell.Value

la variable
toto2 = Left(toto, 2) me renvoie 12 , vu que j'aurai 5000 codes postaux à traiter je commence à m'inquieter.

Je dois certainement louper qq chose mais où ?

j'ai beau chercher sur l'historique du forum je n'arrive pas à résoudre mon pb

Merci d'avance pour votre aide

soan · 30 Juin 2022

sri75 à dit:
avec du "01" ce n'est pas possible

ça ce n'est plus un problème vu que la nouvelle sub Essai() du fichier de mon post #9 retourne un code de département numérique ; note bien qu'il y a Dim Dpt% : idem que Dim Dpt As Integer ➯ c'est bien une donnée numérique, même si je l'ai affichée sur 2 caractères.

sri75 à dit:
mon but est de pouvoir utiliser la macro ci-dessous qui attribue un utilisateur en fonction du numéro de département ( ex de 01 à 56 c'est SRI ) ; avec 1 c'est pas possible.

If ag = "" And totoan2 > 0 And totoan2 < 57 Then ActiveCell.Offset(0, 9).Value = "SRI" Else ActiveCell.Offset(0, 9).Value = "KBO"

ta longue instruction vba avec If peut être abrégée ainsi :

ActiveCell.Offset(, 9) = IIf(ag = "" And totoan2 > 0 And totoan2 < 57, "SRI", "KBO")

mais c'est fortement déconseillé d'utiliser ActiveCell.Offset(, 9) sauf à savoir exactement ce que tu fais, car si la cellule active n'est pas celle qui était prévue au départ, ben même si ça va écrire dans la cellule qui est 9 cellules à droite de la cellule active, ça va quand même écrire à côté, et tu te seras planté ! et j'parle même pas du bug qui va survenir si la cellule active est trop près de la colonne XFD : 9 cellules à droite risque fort de tomber en dehors des limites de la feuille !

soan

soan · 30 Juin 2022

sri75 à dit:
Oups désolé effectivement le Dpt renvoie 1 et non 01 mais il renvoie du chiffre et c'est exactement ce que je voulais.

le msgbox renvoie 01 mais Dpt renvoie 1 et c'était le but recherché; merci beaucoup

ok !

sri75 à dit:
Dernière question : Dpt = Val(Left$(Format([C2], "00000"), 2))

ici le C2 est en dur, que mettre pour que cela prenne la valeur cde la cellule active ?

Dpt = Val(Left$(Format(ActiveCell, "00000"), 2))

mais là aussi, c'est très fortement déconseillé, pour les mêmes raisons !

il faudrait une meilleure vue d'ensemble de ton classeur et de ce que tu veux réellement faire au juste pour pouvoir te fournir une réponse plus adaptée.

soan

sri75 · 30 Juin 2022

merci à tous pour votre aide et vos précieux conseils

Bonne journée à tous

job75 · 30 Juin 2022

Bonjour à tous,

VB:

CP = Left(ActiveCell.Text, 2)

fonctionne quel que soit le format de la cellule (format Texte ou format Spécial Code postal).

A+

soan · 2 Juillet 2022

Bonjour sri75,

cette version écrit les données de groupe / agence / analyste ; sur la feuille "copie" :

note que J2:L7 est entièrement vide ; fais Ctrl e ; vérifie ces résultats de J2:L7 :

si besoin, tu peux demander une adaptation ; à te lire pour avoir ton avis.

code VBA de Module1 (76 lignes) :

VB:

Option Explicit

Dim vx%, lig&

Private Sub groupe()
  Dim chn$
  Select Case vx
 
    'groupe à 1 départ ok
    Case 97: chn = "05"
    Case 20: chn = "06"
    Case 98: chn = "22"
    
    'groupe à 2 départ ok
    Case 73, 74: chn = "11"
    Case 27, 59, 62, 76: chn = "14"
    
    'groupe à 3 départ OK
    Case 32, 46, 47: chn = "01"
    Case 2, 60, 80: chn = "03"
    Case 16, 24, 33: chn = "08"
    Case 18, 36, 58: chn = "09"
    Case 14, 50, 61: chn = "10"
    Case 57, 67, 68: chn = "12"
    Case 21, 52, 71: chn = "13"
    Case 5, 26, 38: chn = "16"
    Case 19, 23, 87: chn = "17"
    Case 1, 42, 69: chn = "18"
    Case 54, 55, 88: chn = "20"
    Case 4, 37, 45: chn = "23"
    Case 75, 93, 94: chn = "24"
    Case 77, 89, 91: chn = "25"
    Case 40, 64, 65: chn = "26"
    Case 8, 10, 51: chn = "28"
    
    'groupe à 4 départ OK
    Case 6, 13, 41, 83: chn = "02"
    Case 25, 39, 70, 90: chn = "07"
    Case 11, 12, 34, 72: chn = "19"
    Case 7, 30, 48, 84: chn = "21"
    Case 17, 79, 85, 86: chn = "27"
    Case 3, 15, 43, 63: chn = "30"
    Case 9, 31, 81, 82: chn = "33"
    Case 28, 78, 92, 95: chn = "34"
    
    'groupe à 5 départ ok
    Case 22, 29, 35, 44, 56: chn = "29"
 
  End Select
  Cells(lig, 10).Value = "GG" & chn
End Sub

Private Sub agence()
  Dim T, i%: T = Array(7, 9, 11, 12, 30, 31, 32, 34, 46, 48, 65, 66, 81, 82, 84)
  For i = 0 To UBound(T)
    If vx = T(i) Then Cells(lig, 11) = 1: Cells(lig, 12) = "MDO": Exit For
  Next i
End Sub

Private Sub analyste()
  Dim ag$: ag = Left$(Cells(lig, 11), 2)
  Cells(lig, 12) = IIf(ag = "" And vx < 57, "SRI", "KBO")
End Sub

Sub lance()
  If ActiveSheet.Name <> "copie" Then Exit Sub
  Dim dlg&: dlg = Cells(Rows.Count, 3).End(3).Row: If dlg = 1 Then Exit Sub
  Dim dpt As String * 5: Application.ScreenUpdating = 0
  Range("J2:L" & dlg).ClearContents
  For lig = 2 To dlg
    With Cells(lig, 3)
      dpt = .Text: vx = Val(Mid$(dpt, 2, 2)): groupe
      vx = Val(Left$(dpt, 2)): agence: analyste
    End With
  Next lig
End Sub

soan

XL 2016 extraction code postal vba

sri75

XLDnaute Occasionnel

soan

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

sri75

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

Pièces jointes

Discussions similaires