Discussion :

[arnaud.i]

Bonjour,

Je souhaiterais joindre 2 array dont la clé est l'ID afin de récupérer le champ quantité dans l'Array1.
Par ailleurs je souhaiterais ajouter un champ "Prix * Quantité".
J'ai ajouté le résultat attendu.
Enfin, les deux array contiendront bcp de données.

Merci d'avance de votre aide



Array1

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim MyArray1(2, 2)
MyArray1(0, 0) = "ID"
MyArray1(0, 1) = "Client"
MyArray1(0, 2) = "Prix"
 
 
MyArray1(1, 0) = "ID1"
MyArray1(1, 1) = "Client A"
MyArray1(1, 2) = 20
 
 
MyArray1(2, 0) = "ID2"
MyArray1(2, 1) = "Client B"
MyArray1(2, 2) = 30

ID	Client	Prix
ID1	Client A	20
ID2	Client B	30

Array2

Code :

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

1
2
3
4
5
6
7
8
9
Dim MyArray2(2, 1)
MyArray2(0, 0) = "ID"
MyArray2(0, 1) = "Quantité"
 
MyArray2(1, 0) = "ID2"
MyArray2(1, 1) = 5
 
MyArray2(2, 0) = "ID1"
MyArray2(2, 1) = 2

ID	Quantité
ID2	5
ID1	2

Résultat souhaité

ID	Client	Prix	Quantité	Prix * Quantité
ID1	Cleint A	20	2	40
ID2	Client B	30	5	150

[MarcelG]

Salut,

Jacques Boisgontier a développé une fonction quant à la fusion horizontale de 2 tableaux.

Via un moteur de recherche, tu y parviendras aisément.

Par ailleurs, une discussion à ce sujet est déjà parue sur ce Forum.

[BENNASR]

Bonjour,
Un fichier téléchargé de ce super site je crois répond à tes besoins si non peut te donner un coup de main pour avancer
Je m'excuse de ne pas cité le nom du membre qui a développé ce code
BONNE CONTINUATION

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
'--- Déclaration des variables
Dim fProd As Worksheet, fMat As Worksheet, fPrix As Worksheet
Dim lProd As Long, lMat As Long, lPrix As Long
Dim dProd As Object, dMat As Object, dPrix As Object, dPrixU As Object
Dim tMat()
Private Sub UserForm_Initialize()
'--- On définit les variables
Set fProd = Feuil1: Set fMat = Feuil2: Set fPrix = Feuil3
lProd = fProd.[a65000].End(xlUp).Row: lMat = fMat.[a65000].End(xlUp).Row: lPrix = fPrix.[a65000].End(xlUp).Row:
Set dProd = CreateObject("Scripting.Dictionary"): Set dMat = CreateObject("Scripting.Dictionary")
Set dPrix = CreateObject("Scripting.Dictionary"): Set dPrixU = CreateObject("Scripting.Dictionary")
With fMat: tMat = fMat.Range(.Cells(2, 1), .Cells(lMat, 3)).Value: End With
'--- On charge les dictionary 1 et 3
For Each Cell In fProd.Range("a2:a" & lProd): dProd(Cell.Value) = Cell.Offset(, 1).Value: Next Cell
For Each Cell In fPrix.Range("a2:a" & lPrix): dPrix(Cell.Value) = Cell.Offset(, 2).Value: Next Cell
'--- On enregistre les valeurs de la combobox
Me.ComboBox1.List = dProd.Keys
End Sub
Private Sub ComboBox1_Change()
'--- On enregistre le code produit
If IsNumeric(Me.ComboBox1.Value) Then code = CLng(Me.ComboBox1.Value) Else: code = Me.ComboBox1.Value
'--- On modifie la valeur du Label
tbLabel = dProd(code)
'--- On calcule le prix unitaire
'- On enregistre les CodeMatPrem et Qu
For i = LBound(tMat) To UBound(tMat)
    If tMat(i, 1) = code Then
        dMat(tMat(i, 2)) = tMat(i, 3)
    End If
Next i
'- On boucle
For Each d In dMat.Keys
    dPrixU(d) = dMat(d) * dPrix(d)
Next d
'- On modifie la valeur du prix
tbPrix = Application.Sum(dPrixU.Items)
'--- On modifie la valeur du complément le plus onéreux
tbOnereux = Application.Max(dPrixU.Items)
'--- On vide les dictionary
dMat.RemoveAll
dPrixU.RemoveAll
End Sub

[boisgontierjacques]

Bonsoir,

Le + simple serait avec une reqête SQL

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
Sub essai()
  Dim MyArray1(2, 2)
  MyArray1(0, 0) = "ID"
  MyArray1(0, 1) = "Client"
  MyArray1(0, 2) = "Prix"
  MyArray1(1, 0) = "ID1"
  MyArray1(1, 1) = "Client A"
  MyArray1(1, 2) = 20
  MyArray1(2, 0) = "ID2"
  MyArray1(2, 1) = "Client B"
  MyArray1(2, 2) = 30
 
  Dim MyArray2(2, 1)
  MyArray2(0, 0) = "ID"
  MyArray2(0, 1) = "Quantité"
  MyArray2(1, 0) = "ID2"
  MyArray2(1, 1) = 5
  MyArray2(2, 0) = "ID1"
  MyArray2(2, 1) = 2
 
'[A2].Resize(UBound(MyArray1) + 1, UBound(MyArray1, 2) + 1) = MyArray1
'[G2].Resize(UBound(MyArray2) + 1, UBound(MyArray2, 2) + 1) = MyArray2
 
  Dim TblResult(2, 4)
  Set d = CreateObject("scripting.dictionary")
  For i = 0 To UBound(MyArray2)
    d(MyArray2(i, 0)) = MyArray2(i, 1)
  Next i
 
  For i = 1 To UBound(MyArray1)
    For k = 0 To 2
      TblResult(i, k) = MyArray1(i, k)
    Next k
    TblResult(i, 3) = d(MyArray1(i, 0))
    TblResult(i, 4) = d(MyArray1(i, 0)) * TblResult(i, 2)
  Next i
  For k = 0 To 2: TblResult(0, k) = MyArray1(0, k): Next k
  TblResult(0, 3) = MyArray2(0, 1)
  TblResult(0, 4) = MyArray2(0, 1) & "*" & MyArray1(0, 2)
  [K2].Resize(UBound(TblResult) + 1, UBound(TblResult, 2) + 1) = TblResult
End Sub

Boisgontier