Recherche H sur ligne active
Bonjour,
Je souhaiterais une macro simple qui me permette de recherche une valeur d'une feuille à une autre, de manière automatique en fonction de la ligne active. Je m'explique, dans le fichier final, il y aura un tableau avec plusieurs affaire dans la feuille 1. Dans la feuille 2, un formulaire à remplir en fonction de certain critère. ce formulaire est à remplir par affaire.
Je souhaite donc une sorte de rechercheh amélioré, qui ira chercher la valeur "x" dans la ligne active de la feuille 1, et que cela change automatiquement en fonction de la ligne que je choisit.
j'espère avoir été clair et que vous pourez répondre à ma question !
Merci d'avance,
Clip
Bonjour,
Je ne suis pas sûr de réellement comprendre ta question ... mais il me semble que tu devrais débuter par un Tableau Croisé Dynamique, car cela te donnera une très grande souplesse d'analyse de tes affaires ...
Salut,
D'abord merci de me répondre. L'idée ici n'est pas d'analyser mes affaires à proprement parler (pas sur cette problématique). L'idée c'est de faire dans une feuil2 par exemple, une rechercheH(valeur_cherche;tableau_donnée;Ligne_active;faux).
Ce que je souhaites c'est un code me permettant de faire en sorte que ligne_active corresponde à la ligne sur laquelle mon curseur sera placé en Feuil1, dans un tableau de suivi.
Comme tu l'as compris, le but étant que peut importe la ligne sur lequel je me place en feuil1, le formulaire en Feuil2 se remplisse en fonction. Plusieurs rechercheH d'élément différents, mais une seule référence de ligne qui change tout le temps: ligne_active.
J'ai un code, mais plutot compliqué, ci-dessous, que je souhaites améliorer (faciliter et raccourcir), le tout totalement automatique, sans userform ou action intermédiaire de préférence:
Code feuil2
Option Explicit
Dim Save_Formula As String
Dim Colonne_Select, Ligne_Select As Long
Dim Cellule_Cible As Boolean
Dim Colonne_Cible, Ligne_Cible As Long
Dim Valeur_Recherche As String
Dim Ligne_REF, Colonne_REF As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'------------------------------------------
'Exit Sub
If Cellule_Cible = True Then
Cellule_Cible = False
On Error Resume Next
If ActiveSheet.Cells(Ligne_REF, Colonne_REF).Value <> Sheets("Tableau suivi").Cells(Ligne_Cible, Colonne_Cible).Value Then
Sheets("Tableau suivi").Cells(Ligne_Cible, Colonne_Cible).Value = ActiveSheet.Cells(Ligne_Select, Colonne_Select).Value
ActiveSheet.Cells(Ligne_Select, Colonne_Select).Formula = Save_Formula
End If
End If
Colonne_REF = 1
Ligne_REF = 1
Save_Formula = ActiveCell.Formula
Colonne_Select = ActiveCell.Column
Ligne_Select = ActiveCell.Row
Select Case Colonne_Select
Case 1: Colonne_Select = 1 ' FOURNISSEUR
If Ligne_Select = 2 Then
Ligne_REF = 36: Colonne_REF = Colonne_Select: Cellule_Cible = True
End If
Case 2: Colonne_Select = 2 'COMMANDE ou n° d'avenant
Select Case Ligne_Select
Case 2
Ligne_REF = 4: Colonne_REF = 17: Cellule_Cible = True
Case 8
Ligne_REF = 36: Colonne_REF = Colonne_Select: Cellule_Cible = True
End Select
Case 4 'Checklist Ponctuelle
Select Case Ligne_Select
Case 34 To 40
Ligne_REF = Ligne_Select: Cellule_Cible = True
Colonne_REF = 17
Case 45: Ligne_REF = 44: Colonne_REF = 4: Cellule_Cible = True 'Observations
End Select
Case 5 'autres fournisseurs consultés
Select Case Ligne_Select
Case 24 To 27
Ligne_REF = Ligne_Select: Cellule_Cible = True
Colonne_REF = 17
End Select
Case 6 'Type achat
If Ligne_Select = 8 Then
Ligne_REF = Ligne_Select: Colonne_REF = 17: Cellule_Cible = True
End If
Case 7 'Réf du CDC
If Ligne_Select = 6 Then
Ligne_REF = 6: Colonne_REF = 4: Cellule_Cible = True
End If
Case 8
Select Case Ligne_Select
Case 4: Ligne_REF = 4: Colonne_REF = 4: Cellule_Cible = True 'Secteur émetteur CDC
Case 8: Ligne_REF = 8: Colonne_REF = 4: Cellule_Cible = True 'Objet
Case 10: Ligne_REF = 10: Colonne_REF = 4: Cellule_Cible = True 'Montant POA/DA
Case 12: Ligne_REF = 12: Colonne_REF = 4: Cellule_Cible = True 'Devise
Case 16: Ligne_REF = 16: Colonne_REF = 4: Cellule_Cible = True 'Montant Commande
Case 21: Ligne_REF = 21: Colonne_REF = 4: Cellule_Cible = True 'Performance acheteur
End Select
Case 9 'Prestation sur site
If Ligne_Select = 18 Then
Ligne_REF = Ligne_Select: Colonne_REF = 4: Cellule_Cible = True
End If
Case 10
Select Case Ligne_Select
Case 31: Ligne_REF = 31: Colonne_REF = 4: Cellule_Cible = True 'Référence commande initiale
End Select
Case 11
Select Case Ligne_Select
Case 24: Ligne_REF = 23: Colonne_REF = 11: Cellule_Cible = True 'Famille d’achats
Case 35, 36: Ligne_REF = Ligne_Select: Colonne_REF = 18: Cellule_Cible = True 'Supplément pour Commande en Uos
Case 39 To 41: Ligne_REF = Ligne_Select: Colonne_REF = 18: Cellule_Cible = True 'Supplément OA sur Site
End Select
Case 13 'acheteur, type budget
Case 14
Select Case Ligne_Select 'sensibilité technique
Case 4: Ligne_REF = 4: Colonne_REF = 11: Cellule_Cible = True 'Programme moteur
Case 6: Ligne_REF = 6: Colonne_REF = 11: Cellule_Cible = True 'Date réception CDC
Case 27: Ligne_REF = Ligne_Select: Colonne_REF = 11: Cellule_Cible = True 'Agrément pour la famille
End Select
End Select
On Error Resume Next
Valeur_Recherche = ActiveSheet.Cells(Ligne_REF, Colonne_REF).Value
On Error Resume Next
Colonne_Cible = Sheets("Tableau suivi").Cells.Find(Valeur_Recherche, LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=True, Matchbyte:=True, SearchOrder:=xlByRows).Column
Ligne_Cible = Cells(2, 17).Value 'ActiveWorkbook.Names("Ligne_Active").Value
End Sub
Code feuil 1
Option Explicit
Dim Numero_Ligne, Numero_Colonne As Long
Dim valeur As Integer
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Numero_Ligne = Selection.Row
Numero_Colonne = Selection.Column
If Selection.Column > 10 Then
On Error GoTo Recréer_nom
ActiveWorkbook.Names("Ligne_Active").Value = Numero_Ligne
Exit Sub
Recréer_nom:
ActiveWorkbook.Names.Add Name:="Ligne_Active", RefersToR1C1:="=1" = Numero_Ligne
End If
End Sub
Bonjour,
Je ne m'attendais pas du tout à se genre de proposition, mais ça fait exactement ce que je voulais, avec seulement un double-click donc c'est parfait
A+
Content que cela corresponde à ton attente ...
Merci pour tes remerciements ...