À l'aide...Petit macro....mais je suis perdu

Magickf · 24 Janvier 2010

Bonjour,

Je suis à la recherche d'un simple macro mais je commence et j'ai de la misère.

Je recherche:

J'ai une feuil1 avec 3 colone: A à C
J'ai une Feuil2 avec 8 colone: A à H

Tout les cellule de la feuil1,colone B sont des code:
Y002, HC32 etc.
Certain de c'est code ce retrouve dans ma feuil2,colone A.

Ce que je veux faire est:

Quand un code est entré dans ma colone (feuil1) B et que ce dernier est présent dans ma (Feuil2) A,

Je veux que la cellule (feuil2)H soit copier dans la cellule (feuil1) C

J'ai vraiment besoin de votre support

MagickF

Excel-lent · 24 Janvier 2010

Re : À l'aide...Petit macro....mais je suis perdu

Bonjour et bienvenu sur le forum Magickf,

Magick à dit:
Quand un code est entré dans ma colone (feuil1) B...

Voici ci-dessous le code que tu cherches :

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    
If Target.Column = 2 Then
    With Sheets("Feuil2")
       For Ligne = 2 To .[A65536].End(xlUp).Row
          If Cells(Target.Row, 2) = .Cells(Ligne, 1) Then
              Cells(Target.Row, 3) = .Cells(Ligne, 8)
          End If
       Next Ligne
    End With
End If

End Sub

Macro à placer sur ta "feuil1" et non pas dans "module", "thisworkbook", ni "Feuil2"

Attention, Sur ta Feuil2, tes codes sont constitué ainsi :
1 lettre + 1 espace + 3 chiffres

Donc si sur la Feuil1 tu saisie ton code ainsi :
1 lettre + 3 chiffres

La macro proposé ne fonctionnera pas!

Bon WE

Edition : merci Jean-Marcel, je te salue également!

Magickf · 24 Janvier 2010

Re : À l'aide...Petit macro....mais je suis perdu

Merci Beaucoup pour cette rapidité

Tout fois, je ne suis pas en mesure de le faire fonctionner.

Outils/Macro/nouveau Macro ........
Alt+F8/ je nomme un nouveau macro et.................
je dois simplement coller ton code dans feuilk 1 si je comprend bien

job75 · 24 Janvier 2010

Re : À l'aide...Petit macro....mais je suis perdu

Bonjour le fil,

Voici 2 solutions, qui fonctionnent avec ou sans espace entré en Feuil1 colonne B.

1) Formule en C2 à tirer vers le bas :

Code:

=SI(NB.SI(Feuil2!$A:$H;REMPLACER(SUPPRESPACE(B2);2;;" "));RECHERCHEV(REMPLACER(SUPPRESPACE(B2);2;;" ");Feuil2!$A:$H;8;0);"")

C'est à mon avis la solution la plus simple.

2) Macro à placer dans le code de Feuil1 (clic droit sur l'onglet et Visualiser le code) :

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, Range("B2:B65536"))
If Target Is Nothing Then Exit Sub
Target.Offset(, 1).FormulaR1C1 = "=IF(COUNTIF(Feuil2!C1:C8,REPLACE(TRIM(RC[-1]),2,,"" "")),VLOOKUP(REPLACE(TRIM(RC[-1]),2,,"" ""),Feuil2!C1:C8,8,0),"""")"
Target.Offset(, 1) = Target.Offset(, 1).Value 'remplace la formule par la valeur
End Sub

A+

Excel-lent · 24 Janvier 2010

Re : À l'aide...Petit macro....mais je suis perdu

Bonjour Magickf, le fil,

Je vois que le temps que je revienne, Jean-Marcel a répondu à ta question 🙂 je te salue également!

Magickf,

En faite, tu n'avais pas besoin de faire :
"Outils/Macro/nouveau Macro ........
Alt+F8/ je nomme un nouveau macro et................."

A la place, il suffisait juste de faire :
"Alt" + "F11"
-> puis cliquer dans la partie de gauche sur "Feuil1"
-> puis coller la macro dans la partie de droite

La manipulation que tu as faite, c'est lorsque tu veux créer une nouvelle macro en utilisant "l'enregistreur de macro".

Bref, excel va enregistrer toutes tes manip. et les traduire en VBA.

Alors que dans le cas présent, le code VBA est déjà tout fait! Presque prêt à l'emploi!

Bon Dimanche à tous

job75 · 24 Janvier 2010

Re : À l'aide...Petit macro....mais je suis perdu

Re,

Pardon, dans mes solutions, ce n'est pas SUPPRESPACE mais SUBSTITUE qu'il faut utiliser.

La formule en C2 :

Code:

=SI(NB.SI(Feuil2!$A:$H;REMPLACER([COLOR="Red"]SUBSTITUE[/COLOR](B2;" ";"");2;;" "));RECHERCHEV(REMPLACER([COLOR="red"]SUBSTITUE[/COLOR](B2;" ";"");2;;" ");Feuil2!$A:$H;8;0);"")

La macro :

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, Range("B2:B65536"))
If Target Is Nothing Then Exit Sub
Target.Offset(, 1).FormulaR1C1 = "=IF(COUNTIF(Feuil2!C1:C8,REPLACE(SUBSTITUTE(RC[-1],"" "",""""),2,,"" "")),VLOOKUP(REPLACE(SUBSTITUTE(RC[-1],"" "",""""),2,,"" ""),Feuil2!C1:C8,8,0),"""")"
Target.Offset(, 1) = Target.Offset(, 1).Value 'remplace la formule par la valeur
End Sub

Je joins les 2 fichiers.

A+

Magickf · 24 Janvier 2010

Re : À l'aide...Petit macro....mais je suis perdu

WoW, je vous remerci grandement pour votre aide.

Et que dire de la rapidité...............................

MagickF

ROGER2327 · 24 Janvier 2010

Re : À l'aide...Petit macro....mais je suis perdu

Bonjour à tous

Suite à la demande privée de Magickf, je livre le résultat de mes élucubrations, bien qu'il semble qu'il soit bien tard...

Une solution par formule dans la feuille "Feuil1" :

Feuille "Feuil1"

Plages nommées :
COD =DECALER(Feuil2!$A$1;;;NBVAL(Feuil2!$A:$A);1)
TEL =DECALER(Feuil2!$H$1;;;NBVAL(Feuil2!$A:$A);1)
Formule nommée :
CODP =SUBSTITUE(COD;" ";"")
Format conditionnel colonne C :
en C2 =OU(ESTNA(C2);ESTERR(C2))
Couleur blanche pour l'écriture
Formule :
en C2 =INDEX(TEL;EQUIV(B2;CODP;0))

Si vous décidez d'unifier le format des codes,
la formule nommée peut être supprimée et la
formule en C2 remplacée par
=INDEX(TEL;EQUIV(B2;COD;0))

Une procédure dans la feuille "Feuil1a" :

Code:

[COLOR="DarkSlateGray"][B][COLOR="SeaGreen"]'Code de la feuille "Feuil1a" :[/COLOR]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cod_V As Object, oCel As Range, oCod As Range, tmp
10 If Not Intersect(Target, Range(Rows(2), Rows(Rows.Count)), Columns(2)) Is Nothing Then
      Application.EnableEvents = False
      On Error GoTo E
40    With Sheets("Feuil2")
50       Set cod_V = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
      End With
70    With Intersect(Target, Range(Rows(2), Rows(Rows.Count)), Columns(2))
80       .Offset(0, 1).Value = Empty
         For Each oCel In .Cells
            If Not IsEmpty(oCel) Then
               tmp = WorksheetFunction.Substitute(oCel.Value, " ", "")
               For Each oCod In cod_V.Cells
                  If tmp = WorksheetFunction.Substitute(oCod.Value, " ", "") Then
140               oCel.Offset(0, 1).Value = oCod.Offset(0, 7).Value
                  End If
               Next oCod
            End If
         Next oCel
      End With
R:    On Error GoTo 0
      Application.EnableEvents = True
   End If
Exit Sub
E: MsgBox "Une erreur imprévue s'est produite."
Resume R
End Sub

[COLOR="SeaGreen"]'Si vous modifiez les plages de lecture et d'écriture des données,
'adaptez les lignes 10, 40, 50, 80, 140.[/COLOR][/B][/COLOR]

Une procédure complémentaire dans la feuille "Feuil2" :

Code:

[COLOR="DarkSlateGray"][B][COLOR="SeaGreen"]'Code de la feuille "Feuil2" :[/COLOR]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cod_W As Object, oCel As Range, oCod As Range, tmp
10 If Not Intersect(Target, Columns(8)) Is Nothing Then
      Application.EnableEvents = False
      On Error GoTo E
40    With Sheets("Feuil1a")
50       Set cod_W = .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp))
      End With
70    For Each oCel In Intersect(Target, Columns(8))
80       tmp = WorksheetFunction.Substitute(oCel.Offset(0, -7).Value, " ", "")
         For Each oCod In cod_W.Cells
            If tmp = WorksheetFunction.Substitute(oCod.Value, " ", "") Then
110            oCod.Offset(0, 1).Value = oCel.Value
            End If
         Next oCod
      Next oCel
R:    Application.EnableEvents = True
   End If
Exit Sub
E: MsgBox "Une erreur imprévue s'est produite."
Resume R
End Sub

[COLOR="SeaGreen"]'Ce code répercute les modifications de la colonne H de cette feuille 
dans la feuille "Feuil1a".
'Si vous modifiez les plages de lecture et d'écriture des données,
'adaptez les lignes 10, 40, 50, 70, 110.[/COLOR][/B][/COLOR]

ROGER2327
#2637

rennais29 · 24 Janvier 2010

Re : À l'aide...Petit macro....mais je suis perdu

je souhaite faire un classement excel de la ligue 1 avec le calendrier que j'actualiseré pares chaque journée.
as tu une solution a mon probléme.

À l'aide...Petit macro....mais je suis perdu

Magickf

Guest

Pièces jointes

Excel-lent

XLDnaute Barbatruc

Magickf

Guest

job75

XLDnaute Barbatruc

Excel-lent

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

Magickf

Guest

ROGER2327

XLDnaute Barbatruc

Pièces jointes

rennais29

Guest

Discussions similaires

À l'aide...Petit macro....mais je suis perdu

Magickf

Guest

Pièces jointes

Excel-lent

XLDnaute Barbatruc

Magickf

Guest

job75

XLDnaute Barbatruc

Excel-lent

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

Magickf

Guest

ROGER2327

XLDnaute Barbatruc

Pièces jointes

rennais29

Guest

Discussions similaires

Privacy & Transparency

Privacy & Transparency