Fonction INDIRECT

[Agé]

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é

 

[Xwprft]

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+

 

[chris]

Re : Fonction INDIRECT

Bonjour

Sur classeur fermé avec la fonction INDIRECT.EXT de l'addon Morefunc disponible ici (entre autres) Ce lien n'existe plus (dérouler le menu morefun (fr)

 

[Agé]

Re : Fonction INDIRECT

Merci beaucoup Xwprft et chris pour votre aide.
C'est parfait !

 

[job75]

Re : Fonction INDIRECT

Bonjour Agé, Xwprft, chris, le forum,

Voici une solution VBA qui évite toute formule.

Macro paramétrée dans Module1 :

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 :

Private Sub Worksheet_Change(ByVal Target As Range)
Recherche IIf(Intersect(Target, [C1]) Is Nothing, Target, Cells)
End Sub

Le code de ThisWorkbook :

Private Sub Workbook_Activate()
Recherche Sheets("RECAP").Cells
End Sub

Fichiers joints à placer dans le même répertoire (par exemple le bureau).

A+

 

[job75]

Re : Fonction INDIRECT

Re,

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

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+

 

[job75]

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+

 

[Agé]

Re : Fonction INDIRECT

Merci job75 pour avoir passer du temps sur mon problème.
C'est plein de bonnes idées pour amèliorer mon fichier.
Encore merci.

Agé

 

[job75]

Re : Fonction INDIRECT

Re,

J'ai agrandi le tableau sur 12 mois.

Sur Win 7 - Excel 2010 il est traité en totalité en 3 secondes.

A+

 

[job75]

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é :

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+

 

[Agé]

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 :

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 :

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 :

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

Comment puis-je faire ?
Merci pour ton aide

 

[job75]

Re : Fonction INDIRECT

Re,

Comment puis-je faire ?

Comment croyez-vous que je travaille ?

Joignez votre fichier pour qu'on puisse adapter ma solution.

A+

 

[Agé]

Re : Fonction INDIRECT

Job75,

Ci-joint le fichier.

Agé

 

[job75]

Re : Fonction INDIRECT

Re,

Ci-joint votre fichier adapté avec cette macro :

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+

 

[job75]

Re : Fonction INDIRECT

Re,

J'ai complété le fichier (5) du post #14 avec les MFC des week-ends.

Il en faut une, différente, pour chaque mois.

A+