ERREUR incompatibilité 13_Application.Index

Le 13/01/2021 à 14:19

Bonjour à tous,

Je me permets de vous solliciter car dans le cadre de mon travail je tente de mettre en place un userform qui permettrait en fonction de filtre multicritères d'extraire des colonnes définis d'une base de donnée dynamique. Pour ce faire et étant débutant en la matière, je me suis appuyer sur les tuto boisgontiers ( que je remercie au passage ).

Private Sub UserForm_Initialize()
On Error Resume Next
  NomTableau = "Tableau1"
  TblBD = Range(NomTableau).Value
  NbCol = UBound(TblBD, 2)
  Set d = CreateObject("scripting.dictionary")
  For i = LBound(TblBD) To UBound(TblBD)
    d(TblBD(i, 9)) = ""
  Next i
  Me.ChoixListBox1.List = d.keys
  Set d = CreateObject("scripting.dictionary")
  For i = LBound(TblBD) To UBound(TblBD)
    d(TblBD(i, 6)) = ""
  Next i
  Me.ChoixListBox2.List = d.keys
  Set d = CreateObject("scripting.dictionary")
  d.comparemode = vbTextCompare
  For i = LBound(TblBD) To UBound(TblBD)
    d(TblBD(i, 10)) = ""
  Next i
  Me.ChoixListBox3.List = d.keys
  Me.ListBox1.ColumnCount = NbCol + 1
  Me.ListBox1.List = TblBD
  Range(NomTableau).ClearFormats
  EnteteListBox
End Sub
Sub Affiche()
  Set dchoisis1 = CreateObject("Scripting.Dictionary")
  For i = 0 To Me.ChoixListBox1.ListCount - 1
    If Me.ChoixListBox1.Selected(i) Then dchoisis1(Me.ChoixListBox1.List(i, 0)) = ""
  Next i
  Set dchoisis2 = CreateObject("Scripting.Dictionary")
  For i = 0 To Me.ChoixListBox2.ListCount - 1
    If Me.ChoixListBox2.Selected(i) Then dchoisis2(Me.ChoixListBox2.List(i, 0)) = ""
  Next i
  Set dchoisis3 = CreateObject("Scripting.Dictionary")
  For i = 0 To Me.ChoixListBox3.ListCount - 1
    If Me.ChoixListBox3.Selected(i) Then dchoisis3(Me.ChoixListBox3.List(i, 0)) = ""
  Next i
  n = 0: Dim Liste()
  For i = LBound(TblBD) To UBound(TblBD)
     tmp = TblBD(i, 9)
     tmp2 = TblBD(i, 6)
     tmp3 = TblBD(i, 10)
     If (dchoisis1.exists(tmp) Or dchoisis1.Count = 0) _
        And (dchoisis2.exists(tmp2) Or dchoisis2.Count = 0) _
          And (dchoisis3.exists(tmp3) Or dchoisis3.Count = 0) Then
         n = n + 1
         ReDim Preserve Liste(1 To NbCol + 1, 1 To n)
         For k = 1 To NbCol
            Liste(k, n) = TblBD(i, k)
         Next k
         Liste(k, n) = i
     End If
  Next i
  If n > 0 Then
    Me.ListBox1.Column = Liste
    Range(NomTableau).ClearFormats
    For i = 0 To Me.ListBox1.ListCount - 1
      ligne = Me.ListBox1.List(i, NbCol)
      Range(NomTableau).Cells(ligne, 1).Resize(, NbCol).Interior.ColorIndex = 4
    Next i
  Else
    Me.ListBox1.Clear
  End If

  Me.txtnbreco.Value = Me.ListBox1.ListCount

 end suB

Si les lignes de code supra fonctionne correctement, à ce stade j'ai un problème (erreur d'incompatibilité 13) lorsque je veux extraire seulement certaines colonnes des données apparaissant dans ma listbox (résultant de mes précédents filtres) dans un nouvel onglet. Voici la ligne de code qui cause le problème (erreur sur la dernière ligne ) :

Private Sub recu_Click()
Application.ScreenUpdating = False
  Set f = Sheets("EXTRACTION")
  n = ListBox1.ListCount
  Tbl = Me.ListBox1.List
f.[A2].Resize(100000, NbCol + 1).ClearContents
f.[A2].Resize(n, 13) = Application.Index(Tbl, Evaluate("Row(1:" & n & ")"), Array(1, 3, 6, 2, 4, 5, 7, 8, 9, 10, 11, 12, 13))</b>

End Sub

Exemple : Le tableau ci-dessous contient 15 colonnes mais le fichier de travail contient 44 colonnes.

image tableau

je joint une capture d'écran de l'userform. ici ma listbox se remplit en fonction des éléments cochés.
le probleme que je rencontre et au moment de l'extraction.
Ici par exemple je souhaiterai programmer le bouton afin d'extraire uniquement les colonnes A, H, M, dans une nouvelle feuille " extraction" ( dans le fichier que je vais utiliser pour le travail, je souhaiterai extraire plus de colonnes [13 au total].

userform

Si l'un d'entre vous pouvait m'expliquer comment corriger cette erreur ou adapter le code au besoin, je lui en serais très reconnaissant.

Je vous remercie d'avance ;

Le 13/01/2021 à 14:34

Salut ,

le code d'erreur viens d'une erreur dans les déclarations des variables il me semble je te conseil d'ajouter ton fichier pour qu'on puisse t'aider personnellement je n'ai pas le niveau requis pour trouver ou est l'erreur désolé

Le 13/01/2021 à 15:59
18test-fichier-light.xlsm (270.40 Ko)

Bonjour,

je te remercie de ton retour, le fichier concerné est un doc du travail et contient des données confidentielles. je peux seulement joindre le fichier draft utilisé sur mon ordi perso afin de m'exercer. En revanche il n'est en aucun point similaire au fichier avec lequel je suis amené à travailler.

Merci d'avance

Le 14/01/2021 à 10:58

Bonjour à tous,

Quel est le souhait précisément ?

La fonction INDEX ne permet renvoyer qu'une unique valeur donc ça ne peut pas marcher. Pouvez-vous essayer ceci :

Private Sub recu_Click()

dim transfo()
dim i%, k%, j%

Set f = Sheets("EXTRACTION")
n = ListBox1.ListCount
redim transfo(1 to n, 1 to 13)
Tbl = application.transpose(application.transpose(Me.ListBox1.List)) '<<<< BASE 1

f.[A2].Resize(100000, NbCol + 1).ClearContents
for i = 1 to n
    for k = 1 to 13
        j = choose(k, 1, 3, 6, 2, 4, 5, 7, 8, 9, 10, 11, 12, 13)
        transfo(i, k) = Tbl(i, j)
    next k
next i

f.[A2].Resize(n, 13) = transfo

End Sub

Cdlt,

Le 14/01/2021 à 12:03

Bonjour à vous,

je te remercie pour ta réponse, je viens de tester le coderai une erreur 9 à ce niveau la :

   transfo(i, k) = Tbl(i, j)

Sinon concernant le souhait , je desserrer extraire dans un nouvel onglets (feuille extraction), des colonnes discontinues ( exemple A,D,G) des données présentes dans ma Listbox1 ( résultantes de filtres multicriteres ).

Dans le fichier joint cela fonctionne , mais lorsque je reproduis le code sur mon fichier de travail, cela engendre une erreur de type 13.

Je pense avoir identifier le problème, il semblerait que dans des colonnes du fichier de travail, il y ai des données de type 16. Toutefois je ne vois pas comment pallier à cela.

Bien à vous !

Le 14/01/2021 à 12:23

Pour l'erreur, je ne vois qu'une explication : Tbl aurait un nombre de colonne inférieure à 13 ou sinon, c'est que la conversion en Base 1 ne s'est pas bien passée...

Peux-tu vérifier à l'aide de la fenêtre variables locales lorsque le bug survient ? Les variables non déclarées dans la présente procédure sont rattachées à Me...

Pour les données de type 16, je ne vois pas trop ce que c'est malheureusement... Ne serait-ce pas dû à des valeurs d'erreur ? Si oui, ne faudrait-il pas corriger ces erreurs en amont, sur le premier tableau, puisque les données en proviennent ?

Cdlt,

Le 14/01/2021 à 13:19

j'ai suivi tes instruction, voila ce que ça donne :

image image

s'agissant des donnée de type 16, il s'agit bien la de valeurs d'erreur. Toutefois le fichier étant dynamique , je ne vois pas bien comment les corriger si ce n'est intégrer un code permettant de transformer le type ( chose que je ne sais pas non plus faire ^^)

Le 14/01/2021 à 13:36

Est-ce que tu peux essayer ainsi :

Private Sub recu_Click()

dim transfo()
dim ii%, kk%, jj%

Set f = Sheets("EXTRACTION")
n = ListBox1.ListCount
redim transfo(1 to n, 1 to 13)
Tbl = application.transpose(application.transpose(Me.ListBox1.List)) '<<<< BASE 1

f.[A2].Resize(100000, NbCol + 1).ClearContents
for ii = 1 to n
    for kk = 1 to 13
        jj = choose(kk, 1, 3, 6, 2, 4, 5, 7, 8, 9, 10, 11, 12, 13)
        transfo(ii, kk) = Tbl(ii, jj)
    next kk
next ii

f.[A2].Resize(n, 13) = transfo

End Sub

car je crois qu'il y a un conflit avec une variable globale nommée k (bizarrement, sa valeur reste à 16 !).

On pourra voir après le problème des données de type 16. Mais il faudrait refaire le circuit tableau1, tblBD, listbox1, Tbl... Peut-être que des valeurs vides peuvent être converties en valeur d'erreur également... A voir

Le 14/01/2021 à 14:00

Je viens de retester, et il subsiste le même souci, ci dessous la capture d'ecran :

image

Pour reformuler ma problématique , je voudrais exporter toujours les mêmes colonnes (ex A, D, E) dans ma feuille extraction mais que ce soit les lignes qui varie en fonction de ma listbox1.

Je sais pas si initialement j'avais bien exposé cela =)

Le 14/01/2021 à 14:12

Oui, désolé, vous l'avez bien répété mais je me suis concentré sur ce premier problème.

Quels sont les critères d'extraction ? Est-il nécessaire de passer par la listbox ?

Le 14/01/2021 à 14:24

C'est bon, je pense que j'ai trouvé, le problème vient du fait que Tbl semble être un tableau monodimensionnel contrairement à ce que je pensais. Est-ce que tu n'as gardé qu'une ligne par hasard pour les tests ?

Je propose donc de repartir ainsi (désolé ) :

Private Sub recu_Click()

dim transfo()
dim ii%, kk%, jj%

Set f = Sheets("EXTRACTION")
n = ListBox1.ListCount
redim transfo(1 to n, 1 to 13)
Tbl = Me.ListBox1.List

f.[A2].Resize(100000, NbCol + 1).ClearContents
for ii = 1 to n
    for kk = 1 to 13
        jj = choose(kk, 1, 3, 6, 2, 4, 5, 7, 8, 9, 10, 11, 12, 13) '<<< laissé tel que car 0 à 15 (16 colonnes)
        transfo(ii, kk) = Tbl(ii - 1, jj) 'sinon jj - 1 également
    next kk
next ii

f.[A2].Resize(n, 13) = transfo

End Sub
Le 14/01/2021 à 14:29

je passe par la listebox car celle ci est voué à changer en fonction des filtres que j'applique (cf. capture). Nécessaire je ne sais pas si il y a un autre moyen je suis ouvert =)

image
Le 14/01/2021 à 14:31

Et bien s'il y avait des critères bien définis, on pourrait se passer de l'userform (intermédiaire peut-être pas nécessaire) et directement filtrer dans le code en appliquant des conditions.

Donc on prend les infos du tableau de base, on dit qu'on ne garde que les dates supérieures ou inférieures et tels montants etc..., et on colle les résultats à l'endroit voulu.

Edit : C'est testé et de mon côté ça marche !

Le 14/01/2021 à 14:50

c'est bon en fait ça marche parfaitement, je te remercie très efficace ta solution.

Concernant l'userform, en effet il ne sert là que d'intermédiaire, la prochaine étape sera de m'en passer mais j'ai encore du chemin en programmation .

Encore une fois merci à toi !!

Le 14/01/2021 à 15:14

Je t'en prie, je suis content que ça marche. J'ai vu ton commentaire avant que tu ne l'édites alors je commente rapidement le code :

Private Sub recu_Click()

dim transfo()
dim ii%, kk%, jj%

Set f = Sheets("EXTRACTION") 'affectation variable f
n = ListBox1.ListCount 'nombre lignes listbox1
redim transfo(1 to n, 1 to 13) 'redimension du tableau à n lignes et 13 colonnes (BASE 1)
Tbl = Me.ListBox1.List 'Tbl récupère les valeurs de listbox1 après filtre (BASE 0)

f.[A2].Resize(100000, NbCol + 1).ClearContents 'effacement sur f à partir de A2 de 100000 lignes et nbcol + 1
for ii = 1 to n 'pour chaque ligne (de transfo)
    for kk = 1 to 13 'pour chaque colonne (de transfo)
        jj = choose(kk, 1, 3, 6, 2, 4, 5, 7, 8, 9, 10, 11, 12, 13) '<<< laissé tel que car 0 à 15 (16 colonnes) 'si kk = 1>jj = 1;kk=2>jj=3;kk=3>jj=6... 
        transfo(ii, kk) = Tbl(ii - 1, jj) 'item de transfo à la ligne ii et colonne kk vaut item Tbl à la ligne ii -1 (car BASE 0) colonne jj
    next kk
next ii

f.[A2].Resize(n, 13) = transfo 'on colle trnsfo en A2 retaillé à n lignes 13 colonnes

End Sub

Cdlt,

Le 14/01/2021 à 15:31

Parfait vraiment utile !

Encore merci pour ta disponibilité !

Rechercher des sujets similaires à "erreur incompatibilite application index"