Aide sur tableau 2 dimensions

**daddygraffiti** · 19/11/2013, 13h16

Bonjour,

J’ai 2 excels ouverts :

XL1 = mon modul macro
XL2 = des données avec :

Col. B = data1
Col.C = data2
Col. K = data3
Col. L se trouve un mot , on dira “chat”.

Lorsque que je lance mon modul (XL1), je veux que la macro trouve dans XL2 le mot « chat » dans la col. L.

Puis, que sur la ligne avec le mot "chat", un tableau se remplisse avec 3 colonnes (data1, data2, data3) mais pour un nombre X de lignes (qui correspondera au nombre de fois ou le mot "chat" est dans la colonne L)

Voici mon code :

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
 
Dim tableau_registre(2, g) As String
Dim g As Integer
Dim mirroir As String
 
'Alimente les éléments du tableau
For g = 0 To UBound(tableau_registre)
 
mirroir = "chat"
Set mirroirCHAT = Worksheets("blabla").Columns("L").Find(mirroir, LookIn:=xlValues)
If Not mirroirCHAT Is Nothing Then
 
chat_data1 = mirroirCHAT.Offset(0, -11).Value
chat_data2 = mirroirCHAT.Offset(0, -10).Value
chat_data3 = mirroirCHAT.Offset(0, -1).Value
 
tableau_registre(0, g) = chat_data1
tableau_registre(1, g) = chat_data2
tableau_registre(2, g) = chat_data3
 
Next g

Or, j’ai une eurreur sur :

Code :

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

 Dim tableau_registre(2, g) As String

Excel me dit « Erreur de compilation : Constante requise ».

Pouvez-vois m’expliquer pourquoi ?
Pouvez-vous me dire si le code que j’ai écrit correspond à mes attentes ?

Merci beaucoup

!

**PMO2017** · 19/11/2013, 17h24

Bonjour,

Une piste sans passer par un tableau. Les variables cernées par des ### sont à adapter à votre besoin.

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
Sub SansTableau()
Dim WB As Workbook
Dim S As Worksheet
Dim R As Range
Dim C As Range
Dim FirstC As String
Dim Miroir As String
 
'### Variables à adapter avec les bons noms ###
Set WB = ActiveWorkbook    'workbooks("nom_du_classeur")
Set S = WB.ActiveSheet     'wb.Sheets("nom_de_la_feuille")
Miroir = "chat"
'##############################################
 
Set R = S.Range("L:L")
'--- 1ère occurrence ---
Set C = R.Find(What:=Miroir, After:=[L65536], LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext)
If C Is Nothing Then
  MsgBox "aucune occurrence trouvée de : " & Miroir
  Exit Sub
End If
FirstC = C.Address
C.Offset(0, 1) = C.Offset(0, -11)
C.Offset(0, 2) = C.Offset(0, -10)
C.Offset(0, 3) = C.Offset(0, -1)
 
'--- Occurrence(s) suivante(s) ---
Do
  Set C = R.FindNext(After:=C)
  If C.Address = FirstC Then Exit Do
  C.Offset(0, 1) = C.Offset(0, -11)
  C.Offset(0, 2) = C.Offset(0, -10)
  C.Offset(0, 3) = C.Offset(0, -1)
Loop
End Sub

********
Si vous voulez absolument utiliser un tableau, je peux vous faire un exemple.

**daddygraffiti** · 20/11/2013, 11h58

Hello,

merci PMO2017 pour ton retour.

Cependant, ton code ne résoud pas la problématique principale qui est le temps de traitement du au poids de XL2.

En effet, si à chaque fois que je trouve le mot "chat" (il y est entre 30 et 40 fois!!!) dans XL2 et que je dois revenir sur XL1 pour coper/coller:

1. chat_data1
puis
2. chat_data2
puis
3. chat_data3

la macro va ga-lé-rer !

C'est pour ca que je cherche à faire un tableau, pour pouvoir recracher mes 3 donnnées d'un coup et surtout améliorer le temps de traitement de la macro.

Peux-tu revoir le code que j'ai posté dans mon premier poste ?

N'hésite pas si tu as des question, et merci encore pour ton retour.

**PMO2017** · 20/11/2013, 18h47

OK, alors avec tableau

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
Sub AvecTableau()
Dim WB As Workbook
Dim S As Worksheet
Dim R As Range
Dim C As Range
Dim FirstC As String
Dim Miroir As String
Dim Tableau_Registre()  '() sans rien = tableau dynamique
Dim cpt&    'compteur
 
'### Variables à adapter avec les bons noms ###
Set WB = ActiveWorkbook         'workbooks("nom_du_classeur")
Set S = WB.Sheets("blabla")     'wb.Sheets("nom_de_la_feuille")
Miroir = "chat"
'##############################################
 
Set R = S.Range("L:L")
'--- 1ère occurrence ---
Set C = R.Find(What:=Miroir, After:=[L65536], LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext)
If C Is Nothing Then
  MsgBox "aucune occurrence trouvée de : " & Miroir
  Exit Sub
End If
FirstC = C.Address
 
cpt& = cpt& + 1
ReDim Preserve Tableau_Registre(1 To 3, 1 To cpt&)  'seule la dernière dimension peut être redimensionnée
Tableau_Registre(1, cpt&) = C.Offset(0, -11)
Tableau_Registre(2, cpt&) = C.Offset(0, -10)
Tableau_Registre(3, cpt&) = C.Offset(0, -1)
 
'--- Occurrence(s) suivante(s) ---
Do
  Set C = R.FindNext(After:=C)
  If C.Address = FirstC Then Exit Do
  cpt& = cpt& + 1
  ReDim Preserve Tableau_Registre(1 To 3, 1 To cpt&)  'seule la dernière dimension peut être redimensionnée
  Tableau_Registre(1, cpt&) = C.Offset(0, -11)
  Tableau_Registre(2, cpt&) = C.Offset(0, -10)
  Tableau_Registre(3, cpt&) = C.Offset(0, -1)
Loop
 
'### Pour visualiser le tableau (à virer par la suite) ###
Set S = ThisWorkbook.Sheets.Add
Set R = S.Range(Cells(1, 1), Cells(UBound(Tableau_Registre, 2), UBound(Tableau_Registre, 1)))
'on transpose le tableau car dimension1=colonnes et dimension2=lignes
'(voir commentaire plus haut)
R = Application.WorksheetFunction.Transpose(Tableau_Registre)
End Sub

**daddygraffiti** · 21/11/2013, 14h11

Bonjour PMO2017,

Merci pour ton exemple complet qui me permet de comprendre un peu mieux les tableaux.

Cependant, sur la ligne 61 erreur d’exécution 438 : Propriété ou méthode non gérée par cet objet

Peux-tu m'aider sur ce point ?

Merci !

Voici le code légérement modifié à ma sauce :

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
 
Sub AvecTableau()
 
Dim WB As Workbook
Dim S As Worksheet
Dim R As Range
Dim C As Range
Dim FirstC As String
Dim Miroir As String
Dim Tableau_Registre()  '() sans rien = tableau dynamique
Dim cpt&    'compteur
 
'ouverture fichier Registre
rappro = "C:\test.xlsx"
Workbooks.Open (rappro)
ActiveWorkbook.RunAutoMacros xlAutoOpen
Worksheets("zatox").Activate
 
'suppression filtres
If Worksheets("zatox").FilterMode Then
Worksheets("zatox").ShowAllData
End If
 
 
'### Variables à adapter avec les bons noms ###
Set WB = Workbooks("test.xlsx")        'workbooks("nom_du_classeur")
Set S = WB.Sheets("zatox")     'wb.Sheets("nom_de_la_feuille")
mot = "chat"
'##############################################
 
 
Set R = S.Range("L:L")
'--- 1ère occurrence ---
Set C = R.Find(What:=Miroir, After:=[L65536], LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext)
'If C Is Nothing Then
  'MsgBox "aucune occurrence trouvée de : " & mot
  'Exit Sub
'End If
FirstC = C.Address
 
cpt& = cpt& + 1
ReDim Preserve Tableau_Registre(1 To 3, 1 To cpt&)  'seule la dernière dimension peut être redimensionnée
Tableau_Registre(1, cpt&) = C.Offset(0, -11)
Tableau_Registre(2, cpt&) = C.Offset(0, -10)
Tableau_Registre(3, cpt&) = C.Offset(0, -1)
 
'--- Occurrence(s) suivante(s) ---
Do
  Set C = R.FindNext(After:=C)
  If C.Address = FirstC Then Exit Do
  cpt& = cpt& + 1
  ReDim Preserve Tableau_Registre(1 To 3, 1 To cpt&)  'seule la dernière dimension peut être redimensionnée
  Tableau_Registre(1, cpt&) = C.Offset(0, -11)
  Tableau_Registre(2, cpt&) = C.Offset(0, -10)
  Tableau_Registre(3, cpt&) = C.Offset(0, -1)
Loop
 
'### Pour visualiser le tableau (à virer par la suite) ###
WB.Worksheets("Feuil1").Activate
Set S = ThisWorkbook.Worksheets("Feuil1").Add
Set R = S.Range(Cells(1, 1), Cells(UBound(Tableau_Registre, 2), UBound(Tableau_Registre, 1)))
'on transpose le tableau car dimension1=colonnes et dimension2=lignes
'(voir commentaire plus haut)
R = Application.WorksheetFunction.Transpose(Tableau_Registre)
 
End Sub

**PMO2017** · 21/11/2013, 14h35

Remplacez

Code :

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

Set S = ThisWorkbook.Worksheets("Feuil1").Add

par

Code :

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

Set S = ThisWorkbook.Sheets.Add

**daddygraffiti** · 21/11/2013, 17h24

Hello PMO2017,

Merci pour ton aide, au top

j'ai pu mettre ça à ma sauce, et ca tourne niquel !

Bonne fin de semaine

Aide sur tableau 2 dimensions [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager