Discussion :

[jpvba]

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

[clementmarcotte]

Bonjour,

Une idée en passant. Mets des espions sur VA, Lig, Col et exécute ta boucle au pas-à-pas. D'un coup que tes valeurs resteraient à 0 ou à null ou seraient quelque chose de bizarre.

[jpvba]

Bonjour Clément,


J'ai donc suivis votre conseille et j'arrive avec ce ceci




Tous semble correcte si je pese sur les petits +, seulement VB reste vide ... vraiment wierd !!!

[Patrice740]

Bonjour,

L'aide Excel pour index :
INDEX(matrice;no_lig;no_col)
matrice est une plage de cellules ou une constante matricielle.

• Si l’argument matrice contient une seule ligne ou colonne, l’argument no_lig ou no_col est facultatif.
  
• Si l’argument matrice comporte plusieurs lignes et plusieurs colonnes et que seul l’argument no_lig ou no_col est utilisé, la fonction INDEX renvoie une matrice des valeurs de la ligne ou de la colonne entière de la matrice.
  

no_lig sélectionne la ligne de la matrice dont une valeur doit être renvoyée. Si l’argument no_lig n’est pas spécifié, l’argument no_col est obligatoire.

no_col sélectionne la colonne de la matrice dont une valeur doit être renvoyée. Si l’argument no_col n’est pas spécifié, l’argument no_lig est obligatoire.

Tes espions indiquent des tableaux pour no_lig et no_col

[jpvba]

Merci Patrice !!!


Donc cette erreur est normale étant donné que dans ce fichier j'ai effectivement un tableau et non une ligne et une colonne ... Là au moins je comprends l'erreur


Donc comment remédié à la situation ... pouvez vous m'aider ???

JE vais comparer le fichier auquel la sub ne fonctione pas versus celui qui fonctionne a merveille afin de pouvoir voir une piste de solution.

[jpvba]

JE viens de faire des test avec le fichier que cela fonctionne mais j'Ai également plusieurs ligne et non une ligne unique de même que pour les colonnes ...





Il y a possiblement quelquechose que je ne comprends pas ...

[clementmarcotte]

Bonjour,

Ce sont en fait des tableaux. Quand tu déploies ta ligne en plussant, tu as les détails à chaque passage dans la boucle. Les + en cascade mènent vers des informations de plus en plus ciblées au sujet de la variable en cours et de sa valeur actuelle.

Dans tes fenêtres, tu as aussi la pile des appels qui permet de remonter sur quelques lignes déjà exécutées. Si jamais, il y a un branchement qui se fait mal, cela devrait te donner une idée.

Et si tu passes ta boucle au pas à pas, tu peux surveiller tes variables "en temps réel". Tu peux mettre un point d'arrêt juste avant ta boucle pour arrêter l'exécution, et ensuite tu fais le pas à pas.

Et tu devrais ajouter au moins deux boutons dans ta barre d'outils : Exécuter jusqu'au curseur (Exécute le programme qui s'arrête à l'instruction où se trouve le curseur) et Définir l'instruction suivante (pour sauter une section et reprendre le programme plus loin)

[jpvba]

Bonjour Clement,

J'ai donc suivi votre conseille ajouter a ma barre d'outils les icone du menu débogage mentionné dans votre post.


En skippant la ligne qui cause l'erreur, je frappe un autre erreur étant donné que plus bas dans mon code, j'utilise = vb et la ligne skippé défini la variable vb.


J'arrive au meme point qu'auparavant. i.e. je sais qu'elle ligne me cause problème, la variable vb n'est pas défini comme il le faut et c'Est malheureusement tout, je ne sais pas comment remédié a cette situation sachant que cela fonctionne dans un autre fichier.

[RyuAutodidacte]

JE viens de faire des test avec le fichier que cela fonctionne mais j'Ai également plusieurs ligne et non une ligne unique de même que pour les colonnes ...





Il y a possiblement quelquechose que je ne comprends pas ...

Bonsoir,

Dans ce cas là c'est que le critère X (x2) a été repéré pour un même nom appartenant à la colonne "AcronyKe étab"
ce qui fait que tu auras récupéré les 2 lignes correspondantes avec les colonnes voulues

Une idée comme ça … , vérifie NC quand tu as l'erreur (ou juste avant) et regarde sa valeur.
Quelle est-elle ??

Normalement celle-ci devrait être composé comme ceci schématiquement :

"Nom_AcronyKeétab|LigneX1" =>pour une ligne (dont le numéro le N° ligne est connu)
"Nom_AcronyKeétab|LigneX1|LigneX2|LigneX3" =>pour plusieurs lignes (ici 3 lignes dont le numéro les N° lignes sont connus)

Edit : en même temps il est possible de vérifier en ammont toutes les valeurs "NC"
puisqu'elles représentent les valeurs qui ont été constituées dans la collection "NewColl"
Donc il suffit de vérifier la collection "NewColl" en la déroulant pour voir chaque valeur et ce avant même l'erreur
peut être que l'une des valeurs est fautive (on verra aussi sa position)
on peut aussi enlever le ou les X dans la/les lignes qui pourrai(en)t peut être posé(es) problème(s) (à cause des données … ???) et relancer le code pour voir si cela passe … ??

[jpvba]

Salut tous le monde, salut Ryu !!!


J'ai donc valider la valeur de NC qui est WYANT|1025|1062|1094|1108|1120 et exécuter la sub en enlevant les x, ligne 1025 testé sans la ligne ainsi de suite et toute les lignes cause la même erreur. J'arrive alors au second NC dans la NewColl (qui est maintenant le premier élément étant donné que j'ai décocher toute les Wyant.


Si au moins j'aurais pu trouver la ligne maudite !!!

[RyuAutodidacte]

hi,

Fait un Debug.Print NC après le For Each NC … et laisse le code se dérouler jusqu'à l'erreur

[jpvba]

Dans la fenêtre d'exécution c'est toujours la même chose WYANT|1025|1062|1094|1108|1120

[RyuAutodidacte]

C’est-à-dire ?
C’est La dernière valeur inscrite par le Debug.Print ??

[jpvba]

C'Est la première ainsi que la dernière valeur inscrite

Code :

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

1
2
3
4
5
6
7
    For Each NC In NewColl
        Debug.Print NC
        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, "|", "")

[RyuAutodidacte]

Quel est la valeur de Lig au dernier Debug.Print ? (Dans les variables locales)

[jpvba]

Après

Code :

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

Lig = Application.Transpose(Split(NC, "|"))

La valeur est un array variant/variant (1 to 6, 1 to 1) dont les 6 lignes sont égales à WYANT|1025|1062|1094|1108|1120

Après

Code :

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

Lig = Application.Index(Lig, Evaluate("Row(2:" & UBound(Lig) & ")"))

La valeur est un array variant/variant (1 to 5, 1 to 1_ dont les 5 lignest sont 1025|1062|1094|1108|1120 (le WYANT a été enlevé)


Tout semble en règle

[jpvba]

Bonjour a vous tous et a Ryu,


Voici donc le fichier en question auquel le code ne fonctionne pas.



MErci encore mille fois pour ton temps hier a essayé de trouvé le glitch



amicalement JP

donnée problèmes.xlsx

[RyuAutodidacte]

Re,

j'ai bien le code au début du post mais pas celui-ci : sheetExists
peux tu le mettre stp

Edit : En fait je n'ai pas nom plus : TrouveLettreColonne
Peux tu mettres l'ensemble des code nécessaire pour que l'on soit à l'identique

[jpvba]

oui, bien sur !!!

Code :

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

1
2
3
Function sheetExists(FEUILLE) As Boolean ' Code Fait par Marc-L
         sheetExists = Evaluate("ISREF('" & FEUILLE & "'!A1)")
End Function

[RyuAutodidacte]

Re,

j'ai pu récupérer ces codes nécessaire (sur l'ancien post)

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
Public Function TrouveLettreColonne(ByVal ColonneCherche As Range)
 
TrouveLettreColonne = Split(Columns(ColonneCherche.Column).Address(ColumnAbsolute:=False), ":")(1)
 
End Function
 
Public Function LastLignUsedInSheet(NomOnglet As String)
 
    LastLignUsedInSheet = Worksheets(NomOnglet).UsedRange.Rows.Count
 
End Function
 
Sub nettoyerseul()
 
    Dim sourceCell As Variant
 
    For Each sourceCell In Selection
        sourceCell.Value = StripAccent(UCase(CleanTrim(sourceCell.Value)))
 
    Next sourceCell
 
End Sub
 
Function StripAccent(thestring As String)
 
    Dim a As String * 1
    Dim b As String * 1
    Dim i As Integer
    Const AccChars = "????ŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏ?ÑÒÓÔÕÖÙÚÛÜ?àáâãäåçèéêëìíîï?ñòóôõöùúûü?ÿ"
    Const RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
 
    For i = 1 To Len(AccChars)
        a = Mid(AccChars, i, 1)
        b = Mid(RegChars, i, 1)
        thestring = Replace(thestring, a, b)
 
    Next
 
    StripAccent = thestring
 
End Function

Ils sont ok ??

par contre il manque toujour CleanTrim