Discussion :

[niniylle]

Bonjour à tous,

Je viens solliciter votre aide, après avoir tout tenté et ne comprenant pas comment résoudre mon problème.
Dans un classeur, nommé "Workfile" j'invite le user à ouvrir un fichier de données nommé "WB_CDWS_Relationship". Jusqu'ici, pas de problème.

Une fois ce fichier ouvert, la macro doit tester que les valeurs contenues dans la colonne "C", sheets "ICT" du Workfile, sont dans la colonne "B", de la sheet n°1 du WB_CDWS_Relationship.
S'il y a une correspondance, je souhaite que la macro, stocke le n° de ligne de la sheet ICT Workfile pour l'utiliser dans une variable, afin d'alimenter une autre feuille du classeur "Workfile"
Voici le bout de code correspondant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Dim CDWS_Input As String
Dim Workfile, WB_CDWS_Relationship As Workbook
Dim C2 As Range
 
Set Workfile = ThisWorkbook
CurrentpAth = ActiveWorkbook.Path
 
 
Set ObjExcel = CreateObject("Excel.Application")
ObjExcel.Visible = False
 
'Custom Filter to help the user to select the right file :
    With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "*C-DWS*Relationship*report*", "*.xl*;*.xslx;*.xlsm;*.xlsb;*.xlam;*.xltx;*.xltm;*.xls;*.xla;*.xlt;*.xlm;*.xlw"
    .Title = "Select the C-DWS Relationship report input file of the Month"
    .InitialFileName = CurrentpAth & "\" & "*C-DWS*Relationship*report*"
    .Show
 
'Open the file selected & links update desactivation
     If .SelectedItems.Count Then
        CDWS_Relationship_Input = .SelectedItems(1) 'Full path retrieving
        Set WB_CDWS_Relationship = Workbooks.Open(Filename:=CDWS_Relationship_Input, UpdateLinks:=xlUpdateLinskNever)
 
     Else: Exit Sub
        End If
        End With
 
 
'CDWS RelationShip report last line detection
LineCDWSRelationship = WB_CDWS_Relationship.Sheets(1).Range("A2").End(xlDown).Row
 
 
'Define range in memory for execution speed
Set col_1 = Workfile.Sheets("ICT PBS mapping").Range("C7:C" & Range("C" & Rows.Count).End(xlDown).Row)
 
With WB_CDWS_Relationship.Sheets(1)
 
 
For I = 3 To LineCDWSRelationship
 
If Application.CountIf(col_1, .Range("B" & I).Value) <> 0 Then
    Set C2 = Workfile.Sheets("ICT PBS mapping").Cells.Find(Range("B" & I).Value) 'Check the cells in ICT PBS Mapping where is the match
    LineICTPBSMap_I = C2.Row 'Store the line from Full List
    LineFullList = 2
  ' store data in variable
    CWPProject = WB_CDWS_Relationship.Worksheets(1).Cells(I, 4)
    CWPActivityID = WB_CDWS_Relationship.Worksheets(1).Cells(I, 5)
    CWPActivityName = WB_CDWS_Relationship.Worksheets(1).Cells(I, 6)
    Del_Master_ActivityID = Workfile.Sheets("ICT PBS mapping").Cells(LineICTPBSMap_I, 13)
    Del_ProjectID = Workfile.Sheets("ICT PBS mapping").Cells(LineICTPBSMap_I, 14)
    Del_IPL = Workfile.Sheets("ICT PBS mapping").Cells(LineICTPBSMap_I, 15)
    Del_IPLName = Workfile.Sheets("ICT PBS mapping").Cells(LineICTPBSMap_I, 17)
 
  'Provide these info in the sheet Full List
  Workfile.Sheets("full list").Cells(LineFullList, 3) = CWPProject
  Workfile.Sheets("full list").Cells(LineFullList, 4) = CWPActivityID
  Workfile.Sheets("full list").Cells(LineFullList, 5) = CWPActivityName
  Workfile.Sheets("full list").Cells(LineFullList, 10) = Del_Master_ActivityID
  Workfile.Sheets("full list").Cells(LineFullList, 11) = Del_ProjectID
  Workfile.Sheets("full list").Cells(LineFullList, 12) = Del_IPL
  Workfile.Sheets("full list").Cells(LineFullList, 13) = Del_IPLName
End If
 
If Application.CountIf(col_1, .Range("C" & I).Value) = 0 Then GoTo Retour
 
LineFullList = LineFullList + 1
Retour:
Next
 
End With
End Sub

La ligne qui me pose problème est la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

LineICTPBSMap_I = C2.Row 'Store the line from Full List

J'ai une erreur d'execution '91' : Variable objet ou variable de bloc with non définie.

J'ai tenté de remettre le nom du workbook avant, de mettre un with avec le workbook avant le Set, et de fermer le with avant le End If, j'ai toujours la même erreur.

Ma recherche fonctionne quand c'est dans le même workbook. Mais pas dès lors que je veux tester dans une feuille d'un autre WB.
Je ne sais pas comment "seter" la chose afin que cela fonctionne.

Savez-vous comment je peux corriger ?
En vous remerciant par avance pour votre aide,

[niniylle]

(Re) Bonjour,

Dans l'attente d'une résolution inespérée,

j'ai trouvé comment contourner, je vais d'abord copier/coller le tableau de mon WB "WB_CDWS_Relationship" dans une feuille de mon classeur "Workfile".
Puis je teste l'appartenance des valeurs. S'il n'y a pas de correspondance, je delete la ligne.
Ce n'est pas optimal, puisque la macro est longue (plus de 52 000 lignes à tester, dont près de la moitié à supprimer) et que cela donne des actions inutiles.

Voici le code de contournement en question :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Dim CDWS_Input As String
Dim Workfile, WB_CDWS_Relationship As Workbook
Dim C2 As Range
 
Set Workfile = ThisWorkbook
CurrentpAth = ActiveWorkbook.Path
 
 
Set ObjExcel = CreateObject("Excel.Application")
ObjExcel.Visible = False
 
'Custom Filter to help the user to select the right file :
    With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "*C-DWS*Relationship*report*", "*.xl*;*.xslx;*.xlsm;*.xlsb;*.xlam;*.xltx;*.xltm;*.xls;*.xla;*.xlt;*.xlm;*.xlw"
    .Title = "Select the C-DWS Relationship report input file of the Month"
    .InitialFileName = CurrentpAth & "\" & "*C-DWS*Relationship*report*"
    .Show
 
'Open the file selected & links update desactivation
     If .SelectedItems.Count Then
        CDWS_Relationship_Input = .SelectedItems(1) 'Full path retrieving
        Set WB_CDWS_Relationship = Workbooks.Open(Filename:=CDWS_Relationship_Input, UpdateLinks:=xlUpdateLinskNever)
 
     Else: Exit Sub
        End If
        End With
 
'CDWS RelationShip report last line detection
LineCDWSRelationship = WB_CDWS_Relationship.Sheets(1).Range("A2").End(xlDown).Row
 
 'Copy data of predecessor in Full List col G to I
 WB_CDWS_Relationship.Sheets(1).Range(Cells(LineCDWSRelationship, 1), Cells(2, 3).End(xlUp).Offset(2)).SpecialCells(xlVisible).Copy
 Workfile.Sheets("full list").Range("G7").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 Application.CutCopyMode = False 'empty clipboard
 
 'Save the input file as "-Done" & close it
WB_CDWS_Relationship.SaveAs Filename:=Split(Dir(CDWS_Relationship_Input), ".")(0) & "- DONE.xlsb", FileFormat:=xlExcel12, CreateBackup:=False
WB_CDWS_Relationship.Close
 
Call Check_FullList_VS_ICT_PBS_Mapping2
 
End Sub

Qui appelle ma macro de contrôle en question :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Sub Check_FullList_VS_ICT_PBS_Mapping2()
Dim C As Range
 
'Last Row detection
LineFullList = Sheets("full list").Range("G6").End(xlDown).Row
LineICTPBSMapping = Sheets("ICT PBS mapping").Range("A6").End(xlDown).Row
 
'Define range in memory for execution speed
Set col_1 = Worksheets("ICT PBS mapping").Range("C7:C" & Range("C" & Rows.Count).End(xlDown).Row)
 
With ThisWorkbook.Sheets("full list")
 
'For all line in the sheet ICT PBS Mapping
For I = LineFullList To 7 Step -1
 
'If the Receipt IPL (col H) is in the Sucessor DWS Activity ID (col C) from sheet ICT PBS Mapping
If Application.CountIf(col_1, .Range("H" & I).Value) <> 0 Then
    Set C = Worksheets("ICT PBS mapping").Cells.Find(Range("H" & I).Value) 'Check the cells in ICT PBS Mapping where is the match
    LineICTPBS_I = C.Row 'Store the line from Full List
 
  ' Keep Predecessor MS Activity ID, Predecessor DWS Project ID, Predecessor DWS Activity ID & Predecessor Baseline Activity name
    Del_Master_ActivityID = Sheets("ICT PBS mapping").Cells(LineICTPBS_I, 13)
    Del_ProjectID = Sheets("ICT PBS mapping").Cells(LineICTPBS_I, 14)
    Del_IPL = Sheets("ICT PBS mapping").Cells(LineICTPBS_I, 15)
    Del_IPLName = Sheets("ICT PBS mapping").Cells(LineICTPBS_I, 17)
 
  'Provide these info in the sheet Full List, col J to L
  Sheets("full list").Cells(I, 10) = Del_Master_ActivityID
  Sheets("full list").Cells(I, 11) = Del_ProjectID
  Sheets("full list").Cells(I, 12) = Del_IPL
  Sheets("full list").Cells(I, 13) = Del_IPLName
 
  Else
  Cells(I, 1).EntireRow.Delete Shift:=xlUp
End If
Next
End With
 
End Sub

Si vous avez une idée pour que je puisse éviter d'en passer par là et que je puisse déjà tester l'appartenance de ces valeurs dans le classeur ouvert, ça serait vraiment top.