Aide sur tableau 2 dimensions

Version imprimable

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:

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:

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 :ccool: !

Bonjour,

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

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
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.

20/11/2013, 11h58
daddygraffiti

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.

:ccool:

OK, alors avec tableau

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
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

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 ? :mrgreen:

Merci ! :ccool:

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

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
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

21/11/2013, 14h35
PMO2017

Remplacez

Code:

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

par

Code:

Set S = ThisWorkbook.Sheets.Add
21/11/2013, 17h24
daddygraffiti

Hello PMO2017,

Merci pour ton aide, au top :ccool:

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

Bonne fin de semaine :mrgreen: