Discussion :

[jmx37]

Bonjour
dans le fichier joint en fiche résultat sont rapatriés les aides du tableau 2 de l'onglet Feuil 1 et je cherche à rapatrier dans une nouvelle colonne (F) de l'onglet résultat les éléments du tableau 3 de l'onglet feuil1, mais je n'y parviens pas.
Voici le code qui a été inséré en feuille résultat, je souhaite le modifier pour intégrer les éléments du tableau 3 de l'onglet Feuil1.

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
Option Explicit
 
Private Sub Worksheet_Activate()
Dim tablo1, nlig&, tablo2, tablo3, ncol%, j%, i&, n&
With Feuil1
	tablo1 = .[A1].CurrentRegion.Resize(, 3)
	nlig = UBound(tablo1)
	If nlig = 1 Then GoTo 1
	tablo2 = .[E1].CurrentRegion.Resize(nlig)
 
	ncol = UBound(tablo2, 2)
End With
'---tableau des résultats---
ReDim resu(1 To ncol * (nlig - 1), 1 To 6)
For j = 1 To ncol
	For i = 2 To nlig
		If tablo2(i, j) <> "" Then
			n = n + 1
			resu(n, 1) = tablo2(1, j)
			resu(n, 2) = tablo1(i, 1)
			resu(n, 3) = tablo1(i, 2)
			resu(n, 4) = tablo1(i, 3)
			resu(n, 5) = tablo2(i, j)
		End If
Next i, j
 
 
'---restitution---
1 If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] 'cellule de restitution, à adapter
	If n Then
		.Resize(n, 5) = resu
		.Resize(n, 5).Borders.Weight = xlThin 'bordures
	End If
	.Offset(n).Resize(Rows.Count - n - .Row + 1, 5).Delete xlUp 'RAZ en dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub

[ARTURO83]

Bonjour,

Une formule matricielle suffit, en F2, à valider avec CTRL +SHIFT + ENTREE et à tirer vers le bas/

Code :

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

=INDEX(Feuil1!$J$1:$M$100;EQUIV($B2& " " &$C2;Feuil1!$A:$A&" "&Feuil1!$B:$B;0);EQUIV($A2;Feuil1!$J$1:$M$1;0))

Cdlt

[OrDonc]

Bonjour …

Ton troisième tableau n’est pas défini dans ton code ainsi que le resu(n , 6).

Me méfiant des .CurrentRegion, je préfère profiter des avantages fournis par les tableaux structurés (on t'en a déjà parlé), nommés, ici, ç1, ç2, c3 puis çR (résultats) avec une procédure VBA du genre :

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
Private Sub Worksheet_Activate()
Dim nlig As Long, ncol As Byte, i As Long, j As Byte, L As Long
    nlig = [ç1].Rows.Count
    ncol = [ç2].Columns.Count
    Application.ScreenUpdating = 0
    For i = 1 To nlig
      For j = 1 To ncol
            L = L + 1
            [çR].Item(L, 1) = [ç2].Item(0, j)
            [çR].Item(L, 2) = [ç1].Item(i, 1)
            [çR].Item(L, 3) = [ç1].Item(i, 2)
            [çR].Item(L, 4) = [ç1].Item(i, 3)
            [çR].Item(L, 5) = [ç2].Item(i, j)
            [çR].Item(L, 6) = [ç3].Item(i, j)
       Next
    Next
End Sub
'pour réinitialiser (permet aussi d'alléger le classeur )
Private Sub Worksheet_Deactivate()
  If Application.CountA([çR]) > 0 Then [çR].Delete
End Sub

Si les tableaux sont énormes, on peut aussi passer par des tableaux VBA mais c’est une autre histoire …
Maintenant tu peux passer par des formules matricielles comme le suggère ARTURO , voire avec PowerQuery (sans VBA aussi) qui te sera probablement proposé.

Edit : pour un autre tri, tu peux permuter les lignes ainsi

Code :

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

1
2
For j = 1 To ncol
    For i = 1 To nlig