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

Fonction INDIRECT

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

A

Agé

Guest
Bonjour,

Es ce possible d'avoir une fonction INDIRECT qui me permettrait de récupérer la valeur d'une cellule située dans un classeur différent de celui de la fonction.
Ci-joint l'exemple avec deux classeurs.
Merci d'avance pour votre aide

Cordialement

Agé
 

Pièces jointes

Re : Fonction INDIRECT

Bonjour Agé,

oui
c'est possible
voir l'exemple. Il faut que le fichier 1 soit ouvert et son nom est à saisir en A4.
D'autres contributeurs du forum pourront certainement améliorer ce point, avec des liens plus souples.
J'ai ajouté une mise en forme automatique des jours de week-end.

A+
 

Pièces jointes

Re : Fonction INDIRECT

Bonjour Agé, Xwprft, chris, le forum,

Voici une solution VBA qui évite toute formule.

Macro paramétrée dans Module1 :

Code:
Sub Recherche(r As Range)
Dim fichier$, x As Variant
fichier = ThisWorkbook.Path & "\[Classeur1.xlsx]" 'à adapter
With r.Parent
  Set r = Intersect(r, .Rows("6:" & .Rows.Count), .UsedRange)
End With
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
For Each r In r
  If r.Column Mod 2 Then Set r = r(1, 2)
  x = ""
  'matricule en C1 => RECAP!RC3
  x = ExecuteExcel4Macro("VLOOKUP(RECAP!R1C3,'" & fichier _
    & r(1, 0).Text & "'!R4C1:R10000C81,81,0)")
  r = IIf(IsError(x), "", x)
Next
Application.EnableEvents = True
End Sub
Le code de la feuille RECAP :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Recherche IIf(Intersect(Target, [C1]) Is Nothing, Target, Cells)
End Sub
Le code de ThisWorkbook :

Code:
Private Sub Workbook_Activate()
Recherche Sheets("RECAP").Cells
End Sub
Fichiers joints à placer dans le même répertoire (par exemple le bureau).

A+
 

Pièces jointes

Re : Fonction INDIRECT

Re,

En passant par un tableau VBA - matrice t - l'exécution est plus rapide :

Code:
Sub Recherche(r As Range)
Dim fichier$, c As Range, rr&, rc%, t, x As Variant
fichier = ThisWorkbook.Path & "\[Classeur1.xlsx]" 'à adapter
With r.Parent
  Set r = Intersect(r, .Rows("6:" & .Rows.Count), .UsedRange)
  If r Is Nothing Then Exit Sub
  For Each c In r.Areas 'pour n'avoir qu'une zone
    Set r = .Range(r, c)
  Next
End With
rr = r.Row - 1: rc = r.Column - 1
t = r.Resize(, r.Columns.Count + 1).Formula 'matrice, plus rapide
Application.DisplayAlerts = False
On Error Resume Next
For Each c In r
  If c.Column Mod 2 Then Set c = c(1, 2)
  'matricule en C1 => RECAP!RC3
  x = ExecuteExcel4Macro("VLOOKUP(RECAP!R1C3,'" & fichier _
    & c(1, 0).Text & "'!R4C1:R10000C81,81,0)")
  t(c.Row - rr, c.Column - rc) = IIf(IsError(x), "", x)
Next
Application.EnableEvents = False
r.Resize(, r.Columns.Count + 1) = t
Application.EnableEvents = True
End Sub
Edit : les dates peuvent être déterminées par des formules.

Fichier (2).

A+
 

Pièces jointes

Dernière édition:
Re : Fonction INDIRECT

Bonjour le fil, le forum,

Dans cette version (3) les dates sont toutes déterminées par formules.

Les week-ends sont colorés par MFC.

A+
 

Pièces jointes

Dernière édition:
Re : Fonction INDIRECT

Re,

Quand le tableau est traité dans son intégralité, les versions précédentes calculaient 2 fois les colonnes paires.

Avec l'argument booléen tout, elles ne sont calculées qu'une seule fois, ce qui réduit la durée d'exécution de moitié :

Code:
Sub Recherche(r As Range, tout As Boolean)
Dim fichier$, c As Range, rr&, rc%, t, x As Variant
fichier = ThisWorkbook.Path & "\[Classeur1.xlsx]" 'à adapter
With r.Parent
  Set r = Intersect(r, .Rows("6:" & .Rows.Count), .UsedRange)
  If r Is Nothing Then Exit Sub
  For Each c In r.Areas 'pour n'avoir qu'une zone
    Set r = .Range(r, c)
  Next
End With
rr = r.Row - 1: rc = r.Column - 1
t = r.Resize(, r.Columns.Count + 1).Formula 'matrice, plus rapide
Application.DisplayAlerts = False
On Error Resume Next
For Each c In r
  If Not tout Or c.Column Mod 2 = 0 Then
    If c.Column Mod 2 Then Set c = c(1, 2)
    'matricule en C1 => RECAP!RC3
    x = ExecuteExcel4Macro("VLOOKUP(RECAP!R1C3,'" & fichier _
      & c(1, 0).Text & "'!R4C1:R10000C81,81,0)")
    t(c.Row - rr, c.Column - rc) = IIf(IsError(x), "", x)
  End If
Next
Application.EnableEvents = False
r.Resize(, r.Columns.Count + 1) = t
Application.EnableEvents = True
End Sub
Fichier (4).

A+
 

Pièces jointes

Dernière édition:
Re : Fonction INDIRECT

Job75,

J'essaie de comprendre ton script pour pouvoir l'adapter à mon fichier qui est à l'origine un peu plus complexe que les pièces jointes du départ.
N'étant pas un spécialiste du VBA, je bute sur l'adaptation.

1 - Le matricule se trouve pas en C1 mais en A1
2 - Les infos récupérées se trouvent sur les colonnes G, S, AE ...etc
3 - La feuille ne se nomme pas forcément RECAP. Elle peut changer de nom car j'ai un ActiveSheet.Name

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Name = Range("M2") & " " & Left(Range("Y2"), 2)
End Sub

Macro paramétrée dans module1 :

Code:
sub recherche(r as range, tout as boolean)
 dim fichier$, c as range, rr&, rc%, t, x as variant
 fichier = thisworkbook.path & "\[classeur1.xlsx]" 'à adapter
 with r.parent
   set r = intersect(r, .rows("6:" & .rows.count), .usedrange)
   if r is nothing then exit sub
   for each c in r.areas 'pour n'avoir qu'une zone
     set r = .range(r, c)
   next
 end with
 rr = r.row - 1: Rc = r.column - 1
 t = r.resize(, r.columns.count + 1).formula 'matrice, plus rapide
 application.displayalerts = false
 on error resume next
 for each c in r
   if not tout or c.column mod 2 = 0 then
     if c.column mod 2 then set c = c(1, 2)
     'matricule en c1 => recap!rc3
     x = executeexcel4macro("vlookup(recap!r1c3,'" & fichier _
       & c(1, 0).text & "'!r4c1:r10000c81,81,0)")
     t(c.row - rr, c.column - rc) = iif(iserror(x), "", x)
   end if
 next
 application.enableevents = false
 r.resize(, r.columns.count + 1) = t
 application.enableevents = true
 end sub
le code de la feuille recap :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C1,H1]) Is Nothing Then Recherche Target, False _
  Else Recherche Cells, True
End Sub
le code de thisworkbook :

Code:
private sub workbook_activate()
recherche sheets("recap").cells
end sub

Comment puis-je faire ?
Merci pour ton aide
 
Dernière modification par un modérateur:
Re : Fonction INDIRECT

Re,

Ci-joint votre fichier adapté avec cette macro :

Code:
Sub Recherche(r As Range)
Dim fichier$, P As Range, i%, rr&, rc%, t, c As Range, x As Variant
fichier = ThisWorkbook.Path & "\[Classeur1.xlsx]" 'à adapter
With r.Parent
  Set P = .[G16:G46]
  For i = 1 To 11
    Set P = Union(P, .[G16:G46].Offset(, 12 * i))
  Next
  Set r = Intersect(r, P, .UsedRange)
End With
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
For Each r In r.Areas 'zone par zone
  rr = r.Row - 1: rc = r.Column - 1
  t = r.Resize(r.Rows.Count + 1) 'matrice, plus rapide
  For Each c In r
    'matricule en A1 => !R1C1
    x = ExecuteExcel4Macro("VLOOKUP('" & c.Parent.Name & "'!R1C1,'" _
      & fichier & c(1, -4).Text & "'!R4C1:R10000C81,81,0)")
    t(c.Row - rr, c.Column - rc) = IIf(IsError(x), "", x)
  Next
  r = t
Next
Application.EnableEvents = True
End Sub
Seules les 12 colonnes de résultats sont traitées, une par une.

Voyez aussi les codes dans la feuille et dans ThisWorkbook.

A+
 

Pièces jointes

Dernière édition:
- 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
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
4
Affichages
379
  • Question Question
Microsoft 365 Rechercher date
Réponses
5
Affichages
226
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…