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

XL 2013 RESOLU - VBA Index Macth avec des variables issues d'un RefEdit

niniylle

XLDnaute Nouveau
Bonjour à tous,

Je viens vers vous après de multiples tentatives infructueuses pour tenter de résoudre mon problème.
Je m'explique:
Dans un classeur "MyWB", une macro me permet d'ouvrir un classeur "EstimateFile". A l'aide d'un UserForm ("Dataselection"), j'invite l'utilisateur à sélectionner une colonne, puis une deuxième.

Ces paramètres vont me servir à faire un Index + Match pour renvoyer des valeurs dans l'onglet "DataExport" de mon classeur MyWB.
Or, lorsque j'exécute ma macro, aucune valeur n'est retournée.
Au fur et à mesure du code, j'ai mis des MsgBox pour tester les variables. Surprise, ils me renvoient les valeurs, mais mon Index Match ne marche pas.
J'ai fait de multiples tentatives (que j'ai mises en commentaires au fur et à mesure), mais je vous fais grâce de cela dans le code (ça allonge beaucoup trop).

J'ai isolé l'Index +Macth dans un autre module, en remplaçant les variables issues de l'UserForm, par leur valeur grâce à des "" . Et l'index marche.
J'ai donc un problème concernant le stockage et l'utilisation des variables issues de l'UserForm.

Voici le code de la macro en question :
VB:
Sub OpenFile2_Work()
Sheets("DataExport").Activate

Dim EstimateFile As String
Dim MyWB As String
Dim DerliData As Integer
MyWB = ThisWorkbook.Name

     With Application.FileDialog(3)
        .Title = "Please select your estimate file"
        .Show

        On Error Resume Next 'si annuler
        Fichier = .SelectedItems(1)
    
        If Err.Number <> 0 Then Exit Sub
        Workbooks.Open Fichier, UpdateLinks:=0 'désactive la MAJ des liaisons

     
    Dataselection.Show
    Dataselection.StartUpPosition = 3 'UserForm centré par rapport à l'écran
  
'Declaration des données du Userform
PartsSheet = Range(Dataselection.RefEditParts).Parent.Name
PartsCol = Dataselection.RefEditParts.Value
PriceSheet = Range(Dataselection.RefEditPrice).Parent.Name
PriceCol = Dataselection.RefEditPrice.Value
Application.ScreenUpdating = False

If Workbooks.Count = 2 Then
For i = 1 To 2
If Not Workbooks(i).Name = ThisWorkbook.Name Then EstimateFile = Workbooks(i).Name
Next i
End If

'Workbooks(MyWB).Sheets("DataExport").Activate
'MsgBox PriceSheet
'MsgBox PartsSheet
'MsgBox PartsCol
'MsgBox PriceCol
'MsgBox MyWB
'MsgBox EstimateFile

On Error Resume Next
'Index
DerliData = Workbooks(MyWB).Sheets("DataExport").Range("C" & Rows.Count).End(xlUp).Row


For Ligne = 2 To DerliData
Workbooks(MyWB).Sheets("DataExport").Cells(Ligne, 7) = WorksheetFunction.Index(Workbooks(EstimateFile).Sheets(PriceSheet).Rance(PriceCol).Columns, WorksheetFunction.Match(Workbooks(MyWB).Sheets("DataExport").Range(Cells(Ligne, 5), Cells(Ligne, 5)), Workbooks(EstimateFile).Sheets(PartsSheet).Range(PartsCol).Columns, 0))
Next
        On Error GoTo 0
End With
   Workbooks(MyWB).Sheets("DataExport").Activate
Application.ScreenUpdating = True

End Sub

Voici le code de l'index match qui fonctionne :
VB:
Sub IndexTest()
Sheets("DataExport").Activate

Dim EstimateFile As String
Dim MyWB As String
Dim DerliData As Integer


Windows("RT_Work_File_BOM Extract-v1.1.xlsm").Activate
Sheets("DataExport").Select
MyWB = ThisWorkbook.Name
'Récupère le nom du fichier ouvert
If Workbooks.Count = 2 Then
For i = 1 To 2
If Not Workbooks(i).Name = ThisWorkbook.Name Then EstimateFile = Workbooks(i).Name
Next i
End If

'Index
DerliData = Workbooks(MyWB).Sheets("DataExport").Range("C" & Rows.Count).End(xlUp).Row

Sheets("DataExport").Activate
  On Error Resume Next

    For Ligne = 2 To DerliData
Cells(Ligne, 7) = WorksheetFunction.Index(Workbooks(EstimateFile).Sheets("Chiffrage").Range("AC:ac"), WorksheetFunction.Match(Workbooks(MyWB).Sheets("DataExport").Range(Cells(Ligne, 5), Cells(Ligne, 5)), Workbooks(EstimateFile).Sheets("Chiffrage").Range("B:B"), 0))
Next
On Error GoTo 0

End Sub

Auriez-vous une idée pour résoudre mon problème svp ?

En vous remerciant par avance pour votre aide précieuse,
 
Dernière édition:

niniylle

XLDnaute Nouveau
Et bien à force d'acharnement, j'ai trouvé la solution et la poste ici.
Cela pourrait servir à d'autres.

Le problème ne venait pas des RefEdit, mais du stockage du nom du fichier ouvert.

A titre d'information, voici le code foncitonnel :
VB:
Sub OpenFile2_WIP2()
Sheets("DataExport").Activate

Dim EstimateFile As String
Dim Parts, Price As String
Dim MyWB As String
Dim DerliData As Integer
MyWB = ThisWorkbook.Name
 
     With Application.FileDialog(3)
        .Title = "Please select your estimate file"
        .Show

        On Error Resume Next 'si annuler
        Fichier = .SelectedItems(1)
     
        If Err.Number <> 0 Then Exit Sub
        Workbooks.Open Fichier, UpdateLinks:=0 'désactive la MAJ des liaisons
       
'Récupère le nom du fichier ouvert 'Placé ici ESTIMATEFILE n'est pas stocké
EstimateFile = ActiveWorkbook.Name
  
    Dataselection.Show
    Dataselection.StartUpPosition = 3 'UserForm centré par rapport à l'écran
   
'Declaration des données du Userform
PartsSheet = Range(Dataselection.RefEditParts).Parent.Name
Parts = Dataselection.RefEditParts.Value
PriceSheet = Range(Dataselection.RefEditPrice).Parent.Name
Price = Dataselection.RefEditPrice.Value
Application.ScreenUpdating = False


   On Error Resume Next
'Index
DerliData = Workbooks(MyWB).Sheets("DataExport").Range("C" & Rows.Count).End(xlUp).Row
Workbooks(MyWB).Activate

For Ligne = 2 To DerliData
Workbooks(MyWB).Sheets("DataExport").Cells(Ligne, 7) = WorksheetFunction.Index(Workbooks(EstimateFile).Sheets(PriceSheet).Range(Price).Columns, WorksheetFunction.Match(Workbooks(MyWB).Sheets("DataExport").Range(Cells(Ligne, 5), Cells(Ligne, 5)), Workbooks(EstimateFile).Sheets(PartsSheet).Range(Parts).Columns, 0))
 
  Next

  On Error GoTo 0
    
    End With
   
'Ferme le fichier ouvert
Workbooks(EstimateFile).Close

Workbooks(MyWB).Sheets("DataExport").Activate
Application.ScreenUpdating = True

End Sub
Bonne journée.
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…