Fonction INDIRECT

Agé

XLDnaute Nouveau
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

  • Classeur1.xlsx
    21.3 KB · Affichages: 68
  • Classeur2.xlsx
    13.9 KB · Affichages: 77
  • Classeur1.xlsx
    21.3 KB · Affichages: 81
  • Classeur2.xlsx
    13.9 KB · Affichages: 68
  • Classeur1.xlsx
    21.3 KB · Affichages: 93
  • Classeur2.xlsx
    13.9 KB · Affichages: 68

Xwprft

XLDnaute Junior
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

  • fonction-indirect-classeur2.xlsx
    15.5 KB · Affichages: 66

job75

XLDnaute Barbatruc
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

  • Classeur2(1).xlsm
    23.7 KB · Affichages: 74
  • Classeur1.xlsx
    21.3 KB · Affichages: 79
  • Classeur2(1).xlsm
    23.7 KB · Affichages: 61
  • Classeur1.xlsx
    21.3 KB · Affichages: 75
  • Classeur2(1).xlsm
    23.7 KB · Affichages: 59
  • Classeur1.xlsx
    21.3 KB · Affichages: 60

job75

XLDnaute Barbatruc
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

  • Classeur1.xlsx
    21.3 KB · Affichages: 67
  • Classeur1.xlsx
    21.3 KB · Affichages: 69
  • Classeur1.xlsx
    21.3 KB · Affichages: 68
  • Classeur2(2).xlsm
    25.1 KB · Affichages: 71
  • Classeur2(2).xlsm
    25.1 KB · Affichages: 78
  • Classeur2(2).xlsm
    25.1 KB · Affichages: 62
Dernière édition:

job75

XLDnaute Barbatruc
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

  • Classeur1.xlsx
    21.3 KB · Affichages: 61
  • Classeur1.xlsx
    21.3 KB · Affichages: 63
  • Classeur1.xlsx
    21.3 KB · Affichages: 79
  • Classeur2(3).xlsm
    26 KB · Affichages: 60
Dernière édition:

job75

XLDnaute Barbatruc
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

  • Classeur1.xlsx
    21.3 KB · Affichages: 72
  • Classeur1.xlsx
    21.3 KB · Affichages: 67
  • Classeur1.xlsx
    21.3 KB · Affichages: 53
  • Classeur2(4).xlsm
    26.4 KB · Affichages: 56
Dernière édition:

Agé

XLDnaute Nouveau
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 édition:

job75

XLDnaute Barbatruc
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

  • Classeur1.xlsx
    21.3 KB · Affichages: 66
  • Classeur2(5).xlsm
    32 KB · Affichages: 64
  • Classeur1.xlsx
    21.3 KB · Affichages: 66
  • Classeur2(5).xlsm
    32 KB · Affichages: 77
  • Classeur1.xlsx
    21.3 KB · Affichages: 72
  • Classeur2(5).xlsm
    32 KB · Affichages: 73
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
314 450
Messages
2 109 721
Membres
110 551
dernier inscrit
Khyolyanna