Tableau attendu VBA

Version imprimable

Tableau attendu VBA

Bonjour à tous ! j'ai un problème sur mon code. Je passe par un tableau pour retranscrire les données (selon la méthode de monsieur boisgontier alain). Mais je n'arrive pas à faire fonctionner.
Je passe par beaucoup de moyens détournés afin que même si les données bougent, cela fonctionne toujours mais je n'arrive pas à voir où est mon erreur ? VBA me dit tableau attendu
Une âme charitable s'il vous plaît ?

Merciiii

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
 
Sub quinemarchepas()
 
  Application.ScreenUpdating = False
 
Dim principal As ThisWorkbook
Dim repertoire As String, fichier As String
Dim myrg As Range
Dim delai_pos As Long, delai_h As Long, lastrow As Long, lastcolumn As Long
  'empêche l'actualisation de l'écran
  Application.ScreenUpdating = False
  'définit le fichier actif comme fichier principal
  Set principal = ThisWorkbook
  repertoire = "L:\Stat_Activite\TDB xxx\" & annéetdb & moistdb & "\MO"
 
  ChDrive "L"
  ChDir repertoire
  fichier = Dir(repertoire & "\" & "xxx.xls")
  Workbooks.Open fichier
 
'définir le dictionnaire pour insérer les données
Set mydico = CreateObject("Scripting.dictionary")
 
'chercher la cellule statut
Cells.Find(What:="xxx", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
  xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
  , SearchFormat:=False).Activate
 
'definir la position de statut
delai_pos = ActiveCell.Column
delai_h = ActiveCell.Row
 
Cells.Find(What:="xxx", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
  xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
  , SearchFormat:=False).Activate
 
'definir la position de statut
xxx = ActiveCell.Column
 
lastrow = Cells(delai_h, delai_pos).End(xlDown).Row
lastcolumn = Cells(delai_h, delai_pos).End(xlToRight).Column
Set myrg = Range(Cells(delai_h, delai_pos), Cells(lastrow, lastcolumn))
 
  For i = LBound(myrg) To UBound(myrg)
 
  mydico.Item(myrg(i, 1)) = Array(myrg(i, 1), myrg(i, 2), myrg(i, 3))
 
  Next i
 
  Application.ScreenUpdating = True
 
ActiveWorkbook.Close False
 
Workbooks("Tableau de correspondances.xlsm").Activate
 
Sheets("alim").Activate
 
b = Application.trnasplose(Application.Transpose(mydico.items))
[F2].Resize(UBound(mydico), UBound(b, 2)) = b
 
 
  Application.ScreenUpdating = True
 
 
End Sub

10/11/2016, 15h02
joe.levrai

Bonjour,

à quel endroit dans ce "bazar" qui ne marche pas (ne le prend pas mal, c'est pas l'idée !) il te demande un tableau

au passage :

Code:

b = Application.trnasplose(Application.Transpose(mydico.items))

relis bien ce que tu as écris, je ne sais pas ce que fais VBA quand tu veux trnasplose un tableau ? Il l'éclate ? :lol:
10/11/2016, 15h09
macadamx

ici

Code:

For i = LBound(myrg) To UBound(myrg)

Merci, je n'ai pas fais attention en tapant mon code

En fait, l'idée est de créer un tableau via myrg (qui n'est pas défini car il dépendra de plusieurs paramètres)
le myrg, je le déclare comme tableau.
Puis j'utilise un dictionnaire pour encapsuler le tableau dans le dictionnaire
10/11/2016, 15h11
joe.levrai
là ton myrg est un Range, une variable objet qui représente la plage physique des cellules

si tu veux que ça soit un tableau :
Code:

1 2 Dim myrg myrg = Range(Cells(delai_h, delai_pos), Cells(lastrow, lastcolumn)).Value
Attention du coup, c'est un tableau en 2 dimensions (lignes / colonnes)
donc cette ligne va encore planter :

Code:

For i = LBound(myrg) To UBound(myrg)

tu dois spécifier la dimension, si tu boucles sur les lignes :

Code:

For i = LBound(myrg,1) To UBound(myrg,1)

et ne jamais oublier de spécifier la dimension dans la suite de la procédure (que je n'ai pas décortiqué)

Ps : sans m'attarder sur la procédure en elle-même pour le moment, tu travailles sur des objects actifs là (par exemple tes ranges et cells ne sont pas rattachés à la feuille hôte) ... c'est TRES dangereux de travailler comme ça
10/11/2016, 15h15
macadamx

maintenant j'ai incompatibilité de type sur la ligne :

Code:

For i = LBound(myrg) To UBound(myrg)

C'est à dire

Citation:

tu travailles sur des objects actifs là (par exemple tes ranges et cells ne sont pas rattachés à la feuille hôte) ... c'est TRES dangereux de travailler comme ça

???

Merci de ton aide !

EDIT :

J'ai vu ton message après avoir posté, cela me met toujours incompatibilité de type sur la ligne :

Code:

For i = LBound(myrg, 1) To UBound(myrg, 1)
10/11/2016, 15h23
joe.levrai

montre tes déclarations de variables
et la ligne où tu alimentes myrg avec ta plage de cellules

La ligne du classeur ?
Excuse moi, je n'ai pas compris ta demande. Je suis loin d'être un pro en la matière
Le myrg est alimenté par les coordonnées des colonnes et des lignes :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
                        'chercher la cellule statut
                        Cells.Find(What:="xxx", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
                               xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                               , SearchFormat:=False).Activate
                               
                        'definir la position
                        delai_pos = ActiveCell.Column
                        delai_h = ActiveCell.Row



                        lastrow = Cells(delai_h, delai_pos).End(xlDown).Row
                        lastcolumn = Cells(delai_h, delai_pos).End(xlToRight).Column

Set myrg = Range(Cells(delai_h, delai_pos), Cells(lastrow, lastcolumn))

cela donne en gros dans ce cas :

range(cells(1,5), cells(16,5)

10/11/2016, 15h27
joe.levrai
Pour faire simple : recopie à nouveau dans ton prochain message l'intégralité de ta procédure modifiée

pour info, exemple de ta première procédure, j'entendais par déclaration de variables ça :
Code:

1 2 3 4 Dim principal As ThisWorkbook Dim repertoire As String, fichier As String Dim myrg As Range Dim delai_pos As Long, delai_h As Long, lastrow As Long, lastcolumn As Long
et la ligne où tu alimentes myrg avec ta plage de cellules ça :

Code:

Set myrg = Range(Cells(delai_h, delai_pos), Cells(lastrow, lastcolumn))

désormais le code complet est comme ceci (les XXX sont les données rendues anonymes) :

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
Sub xxx()
 
    Application.ScreenUpdating = False
 
        Dim principal As ThisWorkbook
        Dim repertoire As String, fichier As String
        Dim myrg
        Dim delai_pos As Long, delai_h As Long, lastrow As Long, lastcolumn As Long
 
            Application.ScreenUpdating = False
 
            'définit le fichier actif comme fichier principal
            Set principal = ThisWorkbook
 
            repertoire = "L:\Stat_Activite\TDBxxx\" & annéetdb & moistdb & "\MO"
 
            ChDrive "L"
            ChDir repertoire
            fichier = Dir(repertoire & "\" & "xxx.xls")
 
                    Workbooks.Open fichier
 
                        'définir le dictionnaire pour insérer les données
                        Set mydico = CreateObject("Scripting.dictionary")
 
                        'chercher la cellule statut
                        Cells.Find(What:="xxx", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
                               xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                               , SearchFormat:=False).Activate
 
                        'definir la position de statut
                        delai_pos = ActiveCell.Column
                        delai_h = ActiveCell.Row
 
                        Cells.Find(What:="xxx", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
                               xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                               , SearchFormat:=False).Activate
 
                        'definir la position de statut
                        xxx= ActiveCell.Column
 
                        lastrow = Cells(delai_h, delai_pos).End(xlDown).Row
                        lastcolumn = Cells(delai_h, delai_pos).End(xlToRight).Column
                        Set myrg = Range(Cells(delai_h, delai_pos), Cells(lastrow, lastcolumn))
 
                            For i = LBound(myrg, 1) To UBound(myrg, 1)
 
                            mydico.Item(myrg(i, 1)) = Array(myrg(i, 1), myrg(i, 2), myrg(i, 3))
 
                            Next i
 
                    ActiveWorkbook.Close False
 
        Workbooks("Tableau de correspondances.xlsm").Activate
 
        Sheets("alim").Activate
 
        b = Application.Transpose(Application.Transpose(mydico.items))
        [F2].Resize(UBound(mydico), UBound(b, 2)) = b
 
 
    Application.ScreenUpdating = True
 
 
End Sub

10/11/2016, 15h36
joe.levrai
Citation:
Envoyé par joe.levrai

Code:

1 2 Dim myrg myrg = Range(Cells(delai_h, delai_pos), Cells(lastrow, lastcolumn)).Value
Tu as respecté la première ligne
Mais pas la seconde :

- tu continues d'utiliser myrg comme une variable objet (utilisation de Set pour l'instancier)
- tu y injectes la plage de données (oublie du .Value à la fin) au lieu des données de la plage (c'est subtil à la lecture, mais lourd de conséquence en VBA)

Etant donné que la variable myrg n'est pas typée (= c'est VBA qui décidera du type de variable quand tu l'utiliseras), hey bien il la prend comme un Range et non pas comme un Tableau

pour info, je passe un USF où je sélectionne le mois et l'année, et en fonction de cela, il va me chercher le fichier que je veux.

les listes sont générées comme ceci :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub userform_initialize()
 
Workbooks("Tableau de correspondances.xlsm").Activate
 
  Set F = Sheets("LISTES")
  Temp = Application.Transpose(Range(F.[a2], F.[a2].End(xlDown)).Value)
  Me.mois.List = Temp
  SendKeys "{F4}"
 
Set F = Sheets("LISTES")
  Temp = Application.Transpose(Range(F.[B2], F.[B2].End(xlDown)).Value)
  Me.année.List = Temp
  SendKeys "{F4}"
 
End Sub

MERCCCCIIIIII !

ça marche ! ! ! !
désolé, je suis novice en la matière et j'ai de grosses lacunes dans les déclarations de variables.
Encore merci de ton aide !
Le code final qui fonctionne :

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
Sub delais()
 
    Application.ScreenUpdating = False
 
        Dim principal As ThisWorkbook
        Dim repertoire As String, fichier As String
        Dim myrg
        Dim delai_pos As Long, delai_h As Long, lastrow As Long, lastcolumn As Long
 
            Application.ScreenUpdating = False
 
            'définit le fichier actif comme fichier principal
            Set principal = ThisWorkbook
 
            repertoire = "L:\Stat_Activite\TDB xxx\" & annéetdb & moistdb & "\MO"
 
            ChDrive "L"
            ChDir repertoire
            fichier = Dir(repertoire & "\" & "xxx.xls")
 
                    Workbooks.Open fichier
 
                        'définir le dictionnaire pour insérer les données
                        Set mydico = CreateObject("Scripting.dictionary")
 
                        'chercher la cellule statut
                        Cells.Find(What:="xxx", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
                               xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                               , SearchFormat:=False).Activate
 
                        'definir la position de statut
                        delai_pos = ActiveCell.Column
                        delai_h = ActiveCell.Row
 
                        Cells.Find(What:="xxx", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
                               xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                               , SearchFormat:=False).Activate
 
                        'definir la position de statut
                        xxx = ActiveCell.Column
 
                        lastrow = Cells(delai_h, delai_pos).End(xlDown).Row
                        lastcolumn = Cells(delai_h, delai_pos).End(xlToRight).Column
                        myrg = Range(Cells(delai_h, delai_pos), Cells(lastrow, lastcolumn)).value
 
                            For i = LBound(myrg, 1) To UBound(myrg, 1)
 
                            mydico.Item(myrg(i, 1)) = Array(myrg(i, 1), myrg(i, 2), myrg(i, 3))
 
                            Next i
 
                    ActiveWorkbook.Close False
 
        Workbooks("Tableau de correspondances.xlsm").Activate
 
        Sheets("alim").Activate
 
        b = Application.Transpose(Application.Transpose(mydico.items))
        [F2].Resize(UBound(b), UBound(b, 2)) = b
 
 
    Application.ScreenUpdating = True
 
 
End Sub

Bonjour,
Code:

1 2 'définit le fichier actif comme fichier principal Set principal = ThisWorkbook
Le fichier actif c'est ActiveWorkbook.
ThisWorkbook est le fichier contenant ce code.
eric