Condition SI ==> Regroupez des pays selon un Code

kiru@

XLDnaute Nouveau
Bonjour,

J'espère que vous pourrez me donner un coup de pouce pour m'aider à faire fonctionner mon fichier.

j'aimerais qu'Excel attribue automatiquement un code aux pays recensés dans mon fichier:

Mais j'éprouve quelques difficultés.

On m'a conconté un code VBA que voici :

sur ta feuil1 a partir de la ligne 7, en colonne 1 tu écris le code en colonne 2 tu mets le pays
fais attention que les noms ne soit pas précédé d'espace

Geog Country
APAC (Asia PACific) China
APAC (Asia PACific) Hong-Kong
APAC (Asia PACific) Japan
APAC (Asia PACific) Malaysia
APAC (Asia PACific) Singapore
APAC (Asia PACific) Taiwan
APAC (Asia PACific) Thailand
APAC (Asia PACific) Indonesia
BELUX (BElgium Luxembourg) Belgium
BELUX (BElgium Luxembourg) Luxembourg
FR France
FR Morocco
FR Austria
GCE Germany
GCE Poland
IB Andorra
IB Portugal
IB Spain
INDIA India
IT Italy

dans la feuille 2

dans cells(1,1) tu écris le non du pays

dans cells(1,2) tappes la formules =rep(LC(-1)

Fonction VBA :

Function rep(pays1)
pays1 = Trim(pays1)
Application.Volatile
Dim tab_code 'Crée une variable
Set tab_code = CreateObject("Scripting.Dictionary" )

l = 7
col = 2
While Sheets("feuil1" ).Cells(l, col) <> ""
pays = Trim(Sheets("feuil1" ).Cells(l, col))
' Sheets("feuil1" ).Cells(l, col) = pays
code = Trim(Sheets("feuil1" ).Cells(l, col - 1))
If code = "" Then
code = code_old
Else
code_old = code
End If
tab_code(pays) = code
l = l + 1
Wend

If tab_code.exists(pays1) Then
rep = tab_code(pays1)
Else
rep = "Non défini"
End If
End Function


Seulement je n'ai rien qui se produit.
JE ne suis pas utilisateur de VBA a la base donc il se peut que j'ai omis de faire quelque chose, j'ai pourtant suivi la démarche ci dessus.

Sauriez vous d'ou peut venir le probleme?
Je vous joint le fichier concerné.
 

Pièces jointes

  • TestVBAPays.xls
    22 KB · Affichages: 91

kiru@

XLDnaute Nouveau
Re : Condition SI ==> Regroupez des pays selon un Code

Re,
Il s'agit d'une fonction(Formule) donc il n'y a rien à modifier !
Si France en I12 et WL en J12 (j'ai supposé que tu écrivais WL pour Worldline mais tu peux changer évidemment)
si en H54 tu saisies
=Rep(I12) renverra FR
=Rep(I12;J12) renverra WorldLine
Si France en I12 et J12 vide
=Rep(I12;J12) renverra FR

Une correction dans le code
Code:
Function rep(pays1, Optional Opt As String)
Dim Tab_code       'Crée une variable
Application.Volatile

pays1 = Trim(pays1)

Set Tab_code = CreateObject("Scripting.Dictionary")
L = 7
Col = 2
    While Sheets("feuil1").Cells(L, Col) <> ""
    pays = Trim(Sheets("feuil1").Cells(L, Col))
    'Sheets("feuil1" ).Cells(l, col) = pays
    code = Trim(Sheets("feuil1").Cells(L, Col - 1))
        If code = "" Then
        code = code_old
        Else
        code_old = code
        End If
    Tab_code(pays) = code
    L = L + 1
    Wend
 
If Not Tab_code.exists(pays1) Then
    rep = "Non défini"
Else
    Select Case Opt
        Case ""
        rep = Tab_code(pays1)
        Case "WL" 'modifie ici le code
        rep = "Worldline"
    End Select
End If
End Function
A+
kjin

J'ai essayé avec mon fichier (que je joint à ce post).

J'obtiens des "0" dans chaque ligne.
 

Pièces jointes

  • test.zip
    13.3 KB · Affichages: 13
  • test.zip
    13.3 KB · Affichages: 15
  • test.zip
    13.3 KB · Affichages: 15

kjin

XLDnaute Barbatruc
Re : Condition SI ==> Regroupez des pays selon un Code

Re
...Si France en I12 et WL en J12 (j'ai supposé que tu écrivais WL pour Worldline mais tu peux changer évidemment)...
Code:
...
        Case "WL" [COLOR="Red"]'modifie ici le code[/COLOR]
Peu-être pas tout lu ?!
Modifie donc le code
Code:
Function rep(pays1, Optional Opt As String)
Dim Tab_code       'Crée une variable
Application.Volatile

pays1 = Trim(pays1)

Set Tab_code = CreateObject("Scripting.Dictionary")
L = 7
Col = 2
    While Sheets("feuil1").Cells(L, Col) <> ""
    pays = Trim(Sheets("feuil1").Cells(L, Col))
    'Sheets("feuil1" ).Cells(l, col) = pays
    code = Trim(Sheets("feuil1").Cells(L, Col - 1))
        If code = "" Then
        code = code_old
        Else
        code_old = code
        End If
    Tab_code(pays) = code
    L = L + 1
    Wend
 
If Not Tab_code.exists(pays1) Then
    rep = "Non défini"
Else
    Select Case Opt
        Case Is <> "Worldline"
        rep = Tab_code(pays1)
        Case "Worldline" 'modifie ici le code
        rep = "Worldline"
    End Select
End If
End Function

A+
kjin
 

Discussions similaires

Statistiques des forums

Discussions
312 428
Messages
2 088 330
Membres
103 814
dernier inscrit
Lolo280277