Bonjour a vous dans un post antérieur ( https://www.developpez.net/forums/d1...rray-possible/), on m'a énorment aider a établir un code plus performant pour la generation d'onglet correspondant a des établissements que j'Ai également adapté pour la génération d'onglet correspondant a des fournisseurs.


Dans un fichier je tombe avec un erreur d'incompatibilité de type 13, qui est habituellement généré lorsque l'on ne déclare pas comme il faut une variable. Cependant la ligne d'erreur est pour des variables déclaré étant variant.



Voici le code 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
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
ub genere_onglets_fournisseur()
 
Dim Col As Variant, DL As Long, Plage As Range, VA As Variant, I As Long, NewColl As New Collection, NC As Variant, Lig As Variant, VB As Variant, DimTab As Integer, NomFeuille As String
Dim Col_Acro As Byte, Col_X As Byte
Dim ligne As Variant
Dim start As Single
Dim finish As Single
Dim LettreVoulue As String
 
If sheetExists("R_MoulinetteAValider") = False Then
MsgBox "Erreur d'exécution, la feuille R_MoulinetteAValider est manquante !!!", vbCritical, "ERREUR"
Exit Sub
Else
End If
 
Col_Acro = [fournisseur_titre].Column
Col_X = [valider_fournisseur_titre].Column
 
 
start = Timer
 
    Col = Array([ID_titre].Column, [seq_titre].Column, [pair_impair_titre].Column, [etab_titre].Column, [acronyme_etab_titre].Column, _
    [item_etab_moulinette_titre].Column, [item_etab_titre].Column, [descr_etab_titre].Column, [couleur_etab_titre].Column, [four_etab_titre].Column, _
    [fournisseur_titre].Column, [marque_etab_titre].Column, [cat_etab_titre].Column, [format_contrat_titre].Column, [qte_an_titre].Column, _
    [prix_contrat_titre].Column, [valider_fournisseur_titre].Column, [commentaire_fournisseur_titre].Column)
 
Sheets("R_MoulinetteAValider").Activate
LettreVoulue = TrouveLettreColonne([Fournisseur])
 
Range(LettreVoulue & 2, LettreVoulue & LastLignUsedInSheet("R_MoulinetteAValider")).Select
    Selection.Replace What:=Chr(47), Replacement:=Chr(32)
    Selection.Replace What:=Chr(92), Replacement:=Chr(32)
    Selection.Replace What:=Chr(91), Replacement:=Chr(32)
    Selection.Replace What:=Chr(93), Replacement:=Chr(32)
    nettoyerseul
 
    With Sheets("R_MoulinetteAValider")
        DL = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set Plage = .Range(Range("A2"), Range(TrouveLettreColonne([commentaire_fournisseur_titre]) & DL))
        VA = Plage
        Set Plage = Nothing
Application.ScreenUpdating = False
        On Error Resume Next
        For I = 1 To UBound(VA)
            If UCase(VA(I, Col_X)) = "X" Then
                NewColl.Add UCase(VA(I, Col_Acro)) & "|" & I, UCase(VA(I, Col_Acro))
                If Err Then
                    Err.Clear
                    ligne = NewColl(UCase(VA(I, Col_Acro)))
                    NewColl.Remove UCase(VA(I, Col_Acro))
                    NewColl.Add ligne & "|" & I, UCase(VA(I, Col_Acro))
                End If
                .Cells(I + 1, Col_X).value = "Extraction OK"
            End If
        Next
        On Error GoTo 0
    End With
 
    For Each NC In NewColl
        NomFeuille = Mid(NC, 1, InStr(NC, "|") - 1)
        Lig = Application.Transpose(Split(NC, "|"))
        Lig = Application.Index(Lig, Evaluate("Row(2:" & UBound(Lig) & ")"))
        VB = Application.Index(VA, Lig, Col)
        DimTab = Len(NC) - Len(Replace(NC, "|", ""))
 
    If Not sheetExists(NomFeuille) Then
        Sheets.Add , Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = NomFeuille
        En_Tete_fourn NomFeuille
        With ActiveSheet.Tab
                        .ThemeColor = xlThemeColorAccent1
                        .TintAndShade = 0.599993896298105
                    End With
    End If
    With Sheets(NomFeuille)
        DL = .Cells(.Rows.Count, 1).End(xlUp)(2).Row
        If DimTab > 1 Then .Cells(DL, 1).Resize(UBound(VB), UBound(VB, 2)).value = VB _
                    Else .Cells(DL, 1).Resize(, UBound(VB)).value = VB
    End With
    Next
 
    finish = Timer
 
MsgBox "durée du traitement: " & finish - start & " secondes"
 
Application.ScreenUpdating = True
 
End Sub
DOnt le code inclue la fonction suivante

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
Function En_Tete_fourn(New_Feuil As String)
 
Dim Entete As Range
    With Sheets("R_MoulinetteAValider")
 
 
        Set Entete = Union(.Range(.Range(TrouveLettreColonne([ID_titre]) & 1), .Range(TrouveLettreColonne([prix_contrat_titre]) & 1)), _
        .Range(.Range(TrouveLettreColonne([valider_fournisseur_titre]) & 1), .Range(TrouveLettreColonne([commentaire_fournisseur_titre]) & 1)))
 
        With Entete
            With .Copy
                With Sheets(New_Feuil).Range("A1")
                .PasteSpecial Paste:=xlPasteColumnWidths
                .PasteSpecial Paste:=xlPasteFormats
                .PasteSpecial Paste:=xlPasteValues
                    With .CurrentRegion
                        With .Columns.item(.Columns.Count)
                        .Copy
                            With .Offset(, 1)
                                .PasteSpecial Paste:=xlPasteColumnWidths:
                                .PasteSpecial Paste:=xlPasteFormats
                            End With
                            With .Offset(, 2)
                                .PasteSpecial Paste:=xlPasteColumnWidths:
                                .PasteSpecial Paste:=xlPasteFormats
                            End With
                            .Offset(, 1).value = "Reponse du fournisseur"
                            .Offset(, 2).value = "Lien internet ou catalogue du fournisseur"
                        End With
                    End With
                End With
            End With
        End With
    End With
    Application.CutCopyMode = False
End Function

L'erreur est généré à la ligne du premier code

Code : Sélectionner tout - Visualiser dans une fenêtre à part
VB = Application.Index(VA, Lig, Col)
Selon les variables locales, la variables VB est vide de type variant/empty




Dans certains fichier, je n'ai pas ce problème tous tourne sur des roulettes, je présume don que les donnés dans les fichier on un type que la macro n'aime pas.

Est-ce que vous pouvez m'aider a réglé ce problème, je présume que je devrais convertir certaines donnée, je ne sais pas où non plus en quel type


merci pour votre aide ... si besoin je peut joindre un fichier, mais je crois quand changeant les données confidentiel, je ne génère plus le problème


amicalement JP