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

VBA - cherche une valeur dans une autre Feuil et renvoie le resultat

  • Initiateur de la discussion Initiateur de la discussion Bens7
  • 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 !

Bens7

XLDnaute Impliqué
Bonjour a tous !!
J'ai un fichier qui contient une feuil: ACTIF, un autre COMMUNE
j'aimerais que effectuter une recherche de chaque ville et d'y inscrire le canton qui corespond ...
je vous met un fichier en pieces jointes c'est plus clair

essayer le BOUTON 1 ca marche mais je sais pas comment lui dire de continuer jusqu'au bout

Merci !!!
 

Pièces jointes

Re : VBA - cherche une valeur dans une autre Feuil et renvoie le resultat

Bonjour Bens, le forum,

Mettre la macro ci-desous dans le module de ta Feuille ACTIF.

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = 0
If Target.Column <> 9 Then Exit Sub
For i = 2 To [I65536].End(xlUp).Row
  If IsError(Application.Match(Cells(i, 9), Feuil4.Columns(1), 0)) Then
  Cells(i, 10) = "?"
  Else
  Cells(i, 10) = Feuil4.Cells(Application.Match(Cells(i, 9), Feuil4.Columns(1), 0), 2)
  End If
Next
Application.EnableEvents = -1
End Sub

A+

Martial
 
Re : VBA - cherche une valeur dans une autre Feuil et renvoie le resultat

Bonjour Martial !
J'ai pas tres bien compris :
je rajoute ce module dans la Feuil ACTIF en gardant mon Bouton ? > marche pas
Je remplace le Code du Bouton par ce module ?> marche pas
Je met ce Code dans la Feuil ACTIF ? > Comment je le lance ?
 
Re : VBA - cherche une valeur dans une autre Feuil et renvoie le resultat

Comme ca ? Comprend pas

Code:
Sub CANTON()
'COPIE LES VALEURS SELON CRITERE DANS ACTIF
Dim i&, j&
j = 2
With Feuil4
For i = 2 To .[A65536].End(xlUp).Row
If .Cells(i, 1) = [I2] Then
Cells(j, 10) = .Cells(i, 2)
j = j + 1
End If
Next
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
 Application.EnableEvents = 0
 If Target.Column <> 9 Then Exit Sub
 For i = 2 To [I65536].End(xlUp).Row
   If IsError(Application.Match(Cells(i, 9), Feuil4.Columns(1), 0)) Then
   Cells(i, 10) = "?"
   Else
   Cells(i, 10) = Feuil4.Cells(Application.Match(Cells(i, 9), Feuil4.Columns(1), 0), 2)
   End If
 Next
 Application.EnableEvents = -1
 End Sub
 
Re : VBA - cherche une valeur dans une autre Feuil et renvoie le resultat

J'ai mis ca dans ACTIF marche pas non plus

Code:
Private Sub CommandButton1_Click(ByVal Target As Range)
 Application.EnableEvents = 0
 If Target.Column <> 9 Then Exit Sub
 For i = 2 To [I65536].End(xlUp).Row
   If IsError(Application.Match(Cells(i, 9), Feuil4.Columns(1), 0)) Then
   Cells(i, 10) = "?"
   Else
   Cells(i, 10) = Feuil4.Cells(Application.Match(Cells(i, 9), Feuil4.Columns(1), 0), 2)
   End If
 Next
 Application.EnableEvents = -1
End Sub
 
Re : VBA - cherche une valeur dans une autre Feuil et renvoie le resultat

bonjour tous🙂
tu peus ecrire comme cela

code de ton bouton

Code:
Sub CANTON()
 Dim t2, t1, a As Long, b As Long
 t1 = Feuil1.Range("i2:j" & Feuil1.Cells(Rows.Count, 9).End(xlUp).Row)
 t2 = Feuil4.Range("a2:b" & Feuil4.Cells(Rows.Count, 1).End(xlUp).Row)
 For a = LBound(t1, 1) To UBound(t1, 1)
 For b = LBound(t2, 1) To UBound(t2, 1)
 If t1(a, 1) = t2(b, 1) Then t1(a, 2) = t2(b, 2)
 Next b: Next a
 Feuil1.Range("i2").Resize(UBound(t1, 1), UBound(t1, 2)) = t1
End Sub
 
Re : VBA - cherche une valeur dans une autre Feuil et renvoie le resultat

Merci Laetitia cependant je remarque une erreur dans mon fichier :
Si par exemple dans Geneve j'ai Geneve" " en fait un espace avant ou apres la Ville ou des saut de ligne ca marche pas
j'ai donc essayer de suprimer en debut et fin des espaces inutiles avec Trim(cell) mais je pensse pas que c'est bon vu que ca m'efface tout voici le code :
Code:
Sub CANTON()
Dim CA As Range
Application.ScreenUpdating = False
    For Each CA In Range("I2:I" & Range("B65536").End(xlUp).Row)
   CA = Trim(Cel) 'supprime les espaces début et fin
Next CA

' CHERCHER LE CANTON
  Dim t2, t1, a As Long, b As Long
  t1 = Feuil1.Range("i2:j" & Feuil1.Cells(Rows.Count, 9).End(xlUp).Row)
  t2 = Feuil4.Range("a2:b" & Feuil4.Cells(Rows.Count, 1).End(xlUp).Row)
  For a = LBound(t1, 1) To UBound(t1, 1)
  For b = LBound(t2, 1) To UBound(t2, 1)
  If t1(a, 1) = t2(b, 1) Then t1(a, 2) = t2(b, 2)
  Next b: Next a
  Feuil1.Range("i2").Resize(UBound(t1, 1), UBound(t1, 2)) = t1

End Sub
Si tu peux me modifier le code Merci !
 
Re : VBA - cherche une valeur dans une autre Feuil et renvoie le resultat

J'ai resolu pour les espaces avant apres mais pas les saut de lignes
voici le code actuel:

Code:
Sub CANTON()
'Suprime les espaces au debut et Fin des Cellules
For Each cel In Range("I2:I" & [B65000].End(xlUp).Row)
cel.Value = Trim(cel.Value) 'Rtrim: espace en fin / Trim: Espace Fin et debut
Next cel

'Cherche le Canton dans la Feuil Commune
  Dim t2, t1, a As Long, b As Long
  t1 = Feuil1.Range("i2:j" & Feuil1.Cells(Rows.Count, 9).End(xlUp).Row)
  t2 = Feuil4.Range("a2:b" & Feuil4.Cells(Rows.Count, 1).End(xlUp).Row)
  For a = LBound(t1, 1) To UBound(t1, 1)
  For b = LBound(t2, 1) To UBound(t2, 1)
  If t1(a, 1) = t2(b, 1) Then t1(a, 2) = t2(b, 2)
  Next b: Next a
  Feuil1.Range("i2").Resize(UBound(t1, 1), UBound(t1, 2)) = t1

End Sub
 
Re : VBA - cherche une valeur dans une autre Feuil et renvoie le resultat

re,

un code qui le fait
Code:
  Selection.Replace What:=Chr(10), Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 
Re : VBA - cherche une valeur dans une autre Feuil et renvoie le resultat

J'ai mis Chr=(9) car les Villes sont dans la collone 9 mais ca marche pas :
Code:
Sub CANTON()

'Suprime les espaces au debut et Fin des Cellules
For Each cel In Range("I2:I" & [B65000].End(xlUp).Row)
cel.Value = Trim(cel.Value) 'Rtrim: espace en fin / Trim: Espace Fin et debut (toujours pas les saut de lignes)
Next cel

'Suprime les saut de lignes
  Selection.Replace What:=Chr(9), Replacement:="", LookAt:=xlPart, _
         SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
         ReplaceFormat:=False

'Cherche le Canton dans la Feuil Commune
  Dim t2, t1, a As Long, b As Long
  t1 = Sheets("ACTIF").Range("i2:j" & Sheets("ACTIF").Cells(Rows.Count, 9).End(xlUp).Row)
  t2 = Sheets("COMMUNE").Range("a2:b" & Sheets("COMMUNE").Cells(Rows.Count, 1).End(xlUp).Row)
  For a = LBound(t1, 1) To UBound(t1, 1)
  For b = LBound(t2, 1) To UBound(t2, 1)
  If t1(a, 1) = t2(b, 1) Then t1(a, 2) = t2(b, 2)
  Next b: Next a
  Sheets("ACTIF").Range("i2").Resize(UBound(t1, 1), UBound(t1, 2)) = t1

End Sub
 
Re : VBA - cherche une valeur dans une autre Feuil et renvoie le resultat

re
en gros ton code sans simplifier donne cela j'ai rajoute une ligne pour les "?"

Code:
 Dim t2, t1, a As Long, b As Long, cel As Range
 Application.ScreenUpdating = 0
 For Each cel In Range("I2:I" & [B65000].End(xlUp).Row)
 cel.Value = Trim(cel.Value)
 cel.Replace What:=Chr(10), Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
  Next cel
  Feuil1.Range("j2:j" & Feuil1.Cells(Rows.Count, 9).End(xlUp).Row) = "?"
  t1 = Feuil1.Range("i2:j" & Feuil1.Cells(Rows.Count, 9).End(xlUp).Row)
  t2 = Feuil4.Range("a2:b" & Feuil4.Cells(Rows.Count, 1).End(xlUp).Row)
  For a = LBound(t1, 1) To UBound(t1, 1)
  For b = LBound(t2, 1) To UBound(t2, 1)
  If t1(a, 1) = t2(b, 1) Then t1(a, 2) = t2(b, 2)
  Next b: Next a
  Feuil1.Range("i2").Resize(UBound(t1, 1), UBound(t1, 2)) = t
1

ps: correction der ligne

Feuil1.Range("i2").Resize(UBound(t1, 1), UBound(t1, 2)) = t

par


Feuil1.Range("i2").Resize(UBound(t1, 1), UBound(t1, 2)) = t1
 
Dernière édition:
Re : VBA - cherche une valeur dans une autre Feuil et renvoie le resultat

re
je viens de me rendre compte si tu ecris

Code:
For Each cel In Range("I2:I" & [B65000].End(xlUp).Row)

la boucle se fait en fonction de la colonne B si rien en colonne B la boucle se fait pas

en corrigeant un peu sans tout passer par des "tablos" vu quand colonne i tu as que 78 cell remplie

Code:
Sub CANTON()
Dim t2, t1, a As Long, b As Long, c As Range
  Application.ScreenUpdating = 0
  For Each c In Feuil1.Range("i2:i" & Feuil1.Cells(Rows.Count, 9).End(xlUp).Row)
  c.Replace What:=Chr(10), Replacement:=""
  c.Value = Trim(c.Value)
  Next c
  Feuil1.Range("j2:j" & Feuil1.Cells(Rows.Count, 9).End(xlUp).Row) = "?"
  t1 = Feuil1.Range("i2:j" & Feuil1.Cells(Rows.Count, 9).End(xlUp).Row)
  t2 = Feuil4.Range("a2:b" & Feuil4.Cells(Rows.Count, 1).End(xlUp).Row)
  For a = LBound(t1, 1) To UBound(t1, 1)
  For b = LBound(t2, 1) To UBound(t2, 1)
  If t1(a, 1) = t2(b, 1) Then t1(a, 2) = t2(b, 2)
  Next b: Next a
  Feuil1.Range("i2").Resize(UBound(t1, 1), UBound(t1, 2)) = t1
End Sub
 
- 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

Discussions similaires

P
Réponses
4
Affichages
1 K
philippe_chalon01
P
C
Réponses
6
Affichages
968
cedric_hiss
C
C
Réponses
0
Affichages
837
cedric_hiss
C
M
Réponses
2
Affichages
809
Misterbean
M
P
Réponses
1
Affichages
16 K
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…