[XL-2016] 0 correspondance par code, alors que visuellement oui

Bonjour le forum,

Désolé pour le titre assez ambigu, je ne savais pas comment l'expliquer en de courts termes.

Voici la ligne de code qui me pose problème...

Code:

1
2
3
4
5
 
For Each Cell In Range("N1:N" & nrc)
Set Rst = Cnn.Execute("SELECT SUM(PayéTTC) FROM [" & Feuille & Cellule & "] WHERE DP > #" & CDate(Range("B5").Value) & "# AND PM > 10 AND (CR = '" & Cell.Value & "' OR PO = '" & Cell.Value & "')")
Cell.Offset(0,1).CopyFromRecordset Rst
Next Cell

nrc est dimensionné en tant que Integer et représente la dernière ligne du tableau.

Rst est bien dimensionné en tant que ADODB.Recordset
Cnn est bien dimensionné en tant que ADODB.Connection et cette dernière est bien reliée au tableur en question via la ligne suivante :

Code:

1
2
3
 
Set Cnn = New ADODB.Connection
Cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";Extended Properties='Excel 12.0;HDR=yes'"

Feuille est dimensionné en tant que String et prend la valeur "2020$"

Cellule est bien dimensionné en tant que Range et se réfère au tableau se situant dans le tableur. Lors du Débogage, les dimensions respectent celles du tableau en tant que tel. (A3:AE315 dans mon cas)

DP correspond à la date de paiement - au 03/03/2020 dans mon test
CDate(Range("B5").Value) - au 15/10/2019
Cette condition est donc respectée.

PM correspond au mois de la prestation - 11 dans mon test
10 est le mois fixé pour les extournes budgétaires.
Cette condition est aussi respectée.

Ensuite, 2 choix possibles : Soit il s'agit d'un contrat (CR) ou d'une commande (PO).
Cell.Value prend la valeur C45690

Dans mon tableur, le contrat C45690 existe bel et bien, et la ligne contient tous les champs précédemment cités en respectant leurs critères.

Ainsi, je ne comprends pas du tout pourquoi aucune correspondance n'est trouvée en sachant que... (pour résumer)
Les variables sont déterminées correctement et les critères sont respectés.

Code:

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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
Option Explicit
 
Private Sub cmbUF_Click()
    UserForm1.Show
End Sub
 
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cnn As ADODB.Connection, CnBud As ADODB.Connection, CnCmd As ADODB.Connection, CnCA As ADODB.Connection, CnExt As ADODB.Connection
Dim Rst As ADODB.Recordset, RstBud As ADODB.Recordset, RstCmd As ADODB.Recordset, RstCA As ADODB.Recordset, RstExt As ADODB.Recordset
Dim Fichier As String, Cellule As String, Feuille As String, nomSite As String, FichierBud As String, CellBud As String, FichierCmd As String, CellCmd As String, FichierCA As String, CellCA As String
Dim FichierExt As String, CellExt As String, tempAff As String, nomRégion As String
Dim n As Integer, i As Integer, nbud As Integer, ncmd As Integer, nca As Integer, nexte As String, j As Integer, nrc As Integer
Dim date_debut As Date
Dim LF As Range, Cell As Range
Dim t As ListObject
 
nomSite = Range("C2").Value
nomRégion = Range("A2").Value
Feuille = "2020$"
'Cette donnée sera à terme une variable
Fichier = "\\prnas01\Region_Nord_Est\NE_Commun\PBR_LOG\ARIBA_2019\TestVBA\TOTAL\TOTAL" & nomRégion & ".xlsx"
FichierBud = "\\prnas01\Region_Nord_Est\NE_Commun\PBR_LOG\ARIBA_2019\TestVBA\Budget\Budget" & nomRégion & ".xlsx"
FichierCmd = "\\prnas01\Region_Nord_Est\NE_Commun\PBR_LOG\ARIBA_2019\TestVBA\Commandes\Commandes" & nomRégion & ".xlsx"
FichierCA = "\\prnas01\Region_Nord_Est\NE_Commun\PBR_LOG\ARIBA_2019\TestVBA\Contrats_Actifs\Contrats_Actifs" & nomRégion & ".xlsx"
FichierExt = "\\prnas01\Region_Nord_Est\NE_Commun\PBR_LOG\ARIBA_2019\TestVBA\Extournes\Extournes" & nomRégion & ".xlsx"
 
    If Target.Address = "$C$2" Or Target.Address = "$B$4" Then
        Range("F2").Value = "OK"
        'Modification pour provoquer l'événement Change lié à cette cellule
        Columns("N").Hidden = True
        Columns("O").Hidden = True
        'Masque les 2 colonnes affichant des résultats temporaires
        ThisWorkbook.Sheets("Resume").Range("A49").Value = "DEPENSES PROVISIONNEES + FACTURES AFFERENTES A L'EXERCICE N-1 PAYEES EN " & Year(Range("B4").Value) - 1
        'Met à jour le titre en fonction de l'année saisie
 
        Set Cnn = New ADODB.Connection
        Cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";Extended Properties='Excel 12.0;HDR=yes'"
 
        Set CnBud = New ADODB.Connection
        CnBud.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FichierBud & ";Extended Properties='Excel 12.0;HDR=yes'"
 
        Set CnCmd = New ADODB.Connection
        CnCmd.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FichierCmd & ";Extended Properties='Excel 12.0;HDR=yes'"
 
        Set CnCA = New ADODB.Connection
        CnCA.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FichierCA & ";Extended Properties='Excel 12.0;HDR=yes'"
 
        Set CnExt = New ADODB.Connection
        CnExt.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FichierExt & ";Extended Properties='Excel 12.0;HDR=yes'"
 
        'Crée les connexions aux classeurs - manipulation de classeur fermés
 
        Set Rst = Cnn.Execute("SELECT count(*) as nb FROM [" & 2020 & "$]")
        n = Rst("nb")
        Cellule = "A3:AE" & n - 2
 
        Set RstBud = CnBud.Execute("SELECT count(*) as nb FROM [" & 2020 & "$]")
        nbud = RstBud("nb")
        CellBud = "A3:I" & nbud + 1
 
        Set RstCmd = CnCmd.Execute("SELECT count(*) as nb FROM [" & 2020 & "$]")
        ncmd = RstCmd("nb")
        CellCmd = "A3:K" & ncmd + 1
 
        Set RstCA = CnCA.Execute("SELECT count(*) as nb FROM [" & 2020 & "$]")
        nca = RstCA("nb")
        CellCA = "A3:U" & nca + 3
 
        Set RstExt = CnExt.Execute("SELECT count(*) as nb FROM [" & 2020 & "$]")
        nexte = RstExt("nb")
        CellExt = "A3:L" & nexte + 1
 
        'Détermine dynamiquement les dimensions du tableau - je n'ai pas trouvé moyen de récupérer les dimensions d'une table nommée dans un tableau fermé
 
        Set t = ListObjects("t_mois")
 
        Set LF = t.DataBodyRange.Find(Month(Range("B4").Value), lookat:=xlWhole, LookIn:=xlValues)
 
        'Prend l'indice lié au mois de la date saisie
 
        If Range("C2").Value = "TOTAL" Then
            For i = 9 To 45
                Set Rst = Cnn.Execute("SELECT SUM(PayéTTC) FROM [" & Feuille & Cellule & "] WHERE P5 = '" & Cells(i, 1) & "' AND (DATE BETWEEN #" & CDate(Range("B4").Value) & "# AND #" & CDate(Range("B5").Value) & "#)")
                Cells(i, 3).CopyFromRecordset Rst
                'Met à jour les résultats de la colonne Conso Réel
 
                Set RstBud = CnBud.Execute("SELECT SUM (Alloué) FROM [" & Feuille & CellBud & "] WHERE P5 = '" & Cells(i, 1) & "'")
                Cells(i, 2).CopyFromRecordset RstBud
                'Met à jour les résultats de la colonne Budget
 
                Set RstCmd = CnCmd.Execute("SELECT SUM(TotalHT) FROM [" & Feuille & CellCmd & "] WHERE P5 = '" & Cells(i, 1) & "'")
                Cells(i, 4).CopyFromRecordset RstCmd
                'Met à jour les résultats de la colonne Charges Planifiées - il s'agit ici des commandes
 
                Set RstCA = CnCA.Execute("SELECT SUM((PTTC2020/12)*" & t.DataBodyRange(LF.Row - 1, 1) & ") FROM [" & 2020 & "$" & CellCA & "] WHERE P5 = '" & Cells(i, 1) & "' AND P5 <> 'Loyers'")
                Cells(i, 9).CopyFromRecordset RstCA
 
                Cells(i, 4) = Cells(i, 4) + Cells(i, 9)
                Cells(i, 9).Value = ""
                'Ajoute les charges planifiées liées aux contrats actifs
 
                Set RstExt = CnExt.Execute("SELECT SUM (DEV) FROM [" & 2020 & "$" & CellExt & "] WHERE P5 = '" & Cells(i, 1) & "'")
                Cells(i + 42, 2).CopyFromRecordset RstExt
                'Met à jour les extournes prévues
 
                Set RstExt = CnExt.Execute("SELECT SUM (Réel) FROM [" & 2020 & "$" & CellExt & "] WHERE P5 = '" & Cells(i, 1) & "'")
                Cells(i + 42, 3).CopyFromRecordset RstExt
            Next i
            Set RstCA = CnCA.Execute("SELECT SUM ((PTTC2020/4)*" & t.DataBodyRange(LF.Row - 1, 3) & ") FROM [" & 2020 & "$" & CellCA & "] WHERE P5 = 'Loyers'")
            Cells(21, 4).CopyFromRecordset RstCA
        Else
            For i = 9 To 45
                Set Rst = Cnn.Execute("SELECT SUM(PayéTTC) FROM [" & Feuille & Cellule & "] WHERE SITE = '" & nomSite & "' AND P5 = '" & Cells(i, 1) & "' AND (DATE BETWEEN #" & CDate(Range("B4").Value) & "# AND #" & CDate(Range("B5").Value) & "#)")
                Cells(i, 3).CopyFromRecordset Rst
 
                Set RstBud = CnBud.Execute("SELECT SUM(Alloué) FROM [" & Feuille & CellBud & "] WHERE SITE = '" & nomSite & "' AND P5 = '" & Cells(i, 1) & "'")
                Cells(i, 2).CopyFromRecordset RstBud
 
                Set RstCmd = CnCmd.Execute("SELECT SUM(TotalHT) FROM [" & Feuille & CellCmd & "] WHERE SITE = '" & nomSite & "' AND P5 = '" & Cells(i, 1) & "'")
                Cells(i, 4).CopyFromRecordset RstCmd
 
                Set RstCA = CnCA.Execute("SELECT SUM((PTTC2020/12)*" & t.DataBodyRange(LF.Row - 1, 1) & ") FROM [" & 2020 & "$" & CellCA & "] WHERE SITE = '" & nomSite & "' AND P5 = '" & Cells(i, 1) & "' AND P5 <> 'Loyers' ")
                Cells(i, 9).CopyFromRecordset RstCA
 
                Cells(i, 4) = Cells(i, 4) + Cells(i, 9)
                Cells(i, 9).Value = ""
 
                Set RstExt = CnExt.Execute("SELECT SUM(DEV) FROM [" & 2020 & "$" & CellExt & "] WHERE SITE = '" & nomSite & "' AND P5 = '" & Cells(i, 1) & "'")
                Cells(i + 42, 2).CopyFromRecordset RstExt
 
                Set RstExt = CnExt.Execute("SELECT SUM (Réel) FROM [" & 2020 & "$" & CellExt & "] WHERE SITE = '" & nomSite & "' AND P5 = '" & Cells(i, 1) & "'")
                Cells(i + 42, 3).CopyFromRecordset RstExt
            Next i
 
            Set RstCA = CnCA.Execute("SELECT SUM((PTTC2020/4)*" & t.DataBodyRange(LF.Row - 1, 3) & ") FROM [" & 2020 & "$" & CellCA & "] WHERE SITE = '" & nomSite & "' AND P5 = 'Loyers'")
            Cells(21, 4).CopyFromRecordset RstCA
        End If
    End If
 
    If Target.Address = "$F$2" Then
        Set CnExt = New ADODB.Connection
        CnExt.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FichierExt & ";Extended Properties='Excel 12.0;HDR=yes'"
 
        Set Cnn = New ADODB.Connection
        Cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";Extended Properties='Excel 12.0;HDR=yes'"
 
 
        Set RstExt = CnExt.Execute("SELECT count(*) as nb FROM [" & 2020 & "$]")
        nexte = RstExt("nb")
        CellExt = "A3:L" & nexte + 1
 
        Set Rst = Cnn.Execute("SELECT count(*) as nb FROM [" & 2020 & "$]")
        n = Rst("nb")
        Cellule = "A3:AE" & n - 2
 
        Set RstExt = CnExt.Execute("SELECT DISTINCT Affectation FROM [" & 2020 & "$" & CellExt & "]")
        Range("N1").CopyFromRecordset RstExt
        'Stocke temporairement la liste des N°CR et N°PO - Regrouper les doublons sous un N°CR/N°PO unique - Pas de Codes BG en Colonne A, autrement impossible de chercher les données
 
        nrc = Columns("N").SpecialCells(xlCellTypeConstants).Rows.Count
 
        For Each Cell In Range("N1:N" & nrc)
            Set Rst = Cnn.Execute("SELECT SUM(PayéTTC) FROM [" & Feuille & Cellule & "] WHERE DP > #" & CDate(Range("B5").Value) & "# AND PM > 10 AND (CR = '" & Cell.Value & "' OR PO = '" & Cell.Value & "')")
            Cell.Offset(0, 1).CopyFromRecordset Rst
            'Stocke temporairement dans la colonne adjacente les résultats extraits du classeur TOTAL correspondant aux extournes (> 15/11/ " année ")
            Set RstExt = CnExt.Execute("UPDATE[" & 2020 & "$" & CellExt & "] SET Réel = '" & CCur(Cell.Offset(0, 1).Value) & "' WHERE Affectation = '" & Cell.Value & "'")
            'Met à jour le classeur Extournes
        Next Cell
 
    End If
End Sub

Voici le code complet... C'est absolument pas le plus optimal, je souhaiterai seulement que ce dernier fonctionne car je me suis dernièrement fait sermonner par mon responsable lors de mon premier livrable... dysfonctionnel - à charge que les lecteurs réseaux ne portent pas la même lettre pour chaque poste (chose que j'ignorais totalement).

NB : Tous les [" & 2020 & "$"... seront remplacés par "Feuille" , qui elle-même à terme sera une variable. Toute variable qui, dans mon cas, est fixée, sera à terme définitivement variable :mouarf:

NB2 : J'ai testé avec toutes les combinaisons possibles des paramètres. Avec les 3, avec les 3 combinaisons à 2 paramètres, avec les 3 paramètres individuellement. Echec total.

Merci pour votre temps, et j'espère avoir été clair sur l'explication de mon problème

0 correspondance par code, alors que visuellement oui - Requête VBA