Extraction des données de deux tableaux distincts

**loulah** · 11/12/2019, 00h17

Salut tout le monde, je viens solliciter votre aide.
Je cherche à créer une macro VBA qui me permet d’extraire les données provenant de deux tableaux distincts I et II dont l’élément commun est la CIN (personne physique) ou bien le RC (personne morale).
Le résultat est un tableau qui regroupe les données extraites des tableaux I et II.
A noté qu’un redevable peut avoir plusieurs comptes bancaires, donc le numéro de l’ATD doit rester le même ainsi que les informations extraites du tableau I le concernant.
Merci d'avance pour votre générosité et votre aide.

**loulah** · 12/12/2019, 02h07

Bonjour ;
Tout d'abord merci pour le conseil et aussi pour avoir attiré mon attention sur le risque éventuelle des PJ.
Je viens solliciter de l'aide pour soulager un collègue et ami qui travaille sur une BD très grande par la création d'une macro VBA qui permet d'extraire et d'ajouter les données provenant de deux tableaux distincts I et II dont l’élément commun est la CIN (personne physique) ou bien le RC (personne morale).
Tableau I :

N°	Libellé Tiers	Catégorie Tiers	Identifiant	CIN	RC	Adresse	Montant Principal	Montant Majoration	Montant Frais de Poursuite	Montant Total
1	A	Personne physique	PP1	X1234		Rue 1	123,00	12,30	10,00	145,30
2	B	Personne physique	PP2	X1235		Rue 2	345,00	34,50	20,00	399,50
3	C	Personne physique	PP3	X1236		Rue 3	567,00	56,70	30,00	653,70
4	D	Personne physique	PP4	X1237		Rue 4	789,00	78,90	40,00	907,90
5	E	Personne morale	PM1		Y1234	Rue 5	909,00	90,90	50,00	1 049,90
6	F	Personne physique	PP6	X1239		Rue 6	987,00	98,70	60,00	1 145,70
7	G	Personne physique	PP7	X1240		Rue 7	765,00	76,50	70,00	911,50
8	H	Personne morale	PM2		Y1237	Rue 8	543,00	54,30	80,00	677,30
9	I	Personne morale	PM3		Y1238	Rue 9	321,00	32,10	90,00	443,10
10	J	Personne physique	PP10	X1243		Rue 10	160,00	16,00	100,00	276,00

Tableau II :

Nom client banque	CIN	RC	Bq	Ville	N° Compte
A	X1234		B1	V1	N1
A	X1234		B11	V11	N11
A	X1234		B111	V111	N111
B	X1235		B2	V2	N2
B	X1235		B22	V22	N22
B	X1235		B222	V222	N222
B	X1235		B2222	V2222	N2222
C	X1236		B3	V3	N3
D	X1237		B4	V4	N4
E		Y1234	B5	V5	N5
E		Y1234	B55	V55	N55
F	X1239		B6	V6	N6
G	X1240		B7	V7	N7
H		Y1237	B8	V8	N8
H		Y1237	B81	V81	N81
H		Y1237	B82	V82	N82
H		Y1237	B83	V83	N83
I		Y1238	B9	V9	N9
J	X1243		B10	V10	N10
J	X1243		B101	V101	N101

Le résultat est un tableau qui regroupe les données extraites des tableaux I et II.

ATD	Libellé Tiers	CIN	RC	ADRESSE	Montant Principal	Montant Majoration	Montant Frais de Poursuite	Montant Total	Bq	Ville	N° Compte

Colonne A: numéro de l'ATD qui s'incrémente seul sous la forme : 0001/année en cours Extrait du tableau n° I Extrait du tableau n° II

A noté qu’un client peut avoir plusieurs comptes bancaires, donc autant de ligne que de compte bancaire.
Aussi le numéro de l’ATD doit rester le même ainsi que les informations extraites du tableau I concernant le client qui a plusieurs comptes.
Merci d'avance pour votre générosité et votre aide.

**BENNASR** · 12/12/2019, 08h25

bonjour
je ne sais pas quelle version Excel vous utilisez mais je crois que Power Query répond parfaitement à ton cas
Beaucoup de tutoriel et des vidéos sur le net parle de cet outil
c'est faisable aussi avec VBA mais ça demande beaucoup de travail et je doute que vous trouvez ici un code clés en main .... mais qui sait !!

bonne continuation

**78chris** · 12/12/2019, 09h12

Bonjour à tous

C'est effectivement faisable en PowerQuery : en addon à partir de 2010 et intégré à partir de 2016

Une requête est dynamique et reclaculée à l'instant T
"numéro de l'ATD qui s'incrémente seul sous la forme : 0001/année en cours" : si le tableau doit perdurer sur plusieurs années, la notion d'année en cours nécessiterait de figer l'année.
Ce qui ne peut être fait qu'en ajoutant l'information aux tableau I et II

Donc point à préciser... d'autant que dans ce cas le compteur doit repartir à 0

**loulah** · 12/12/2019, 16h33

Envoyé par BENNASR

Bonjour et merci pour l’intérêt que vous avez donné à ma requête. je vais essayer d'en savoir un peu plus sur le Powezr Query.
merci encore et au plaisir de vous lire.

Envoyé par 78chris

Bonjour et merci pour l’intérêt que vous avez donné à ma requête.
En réponse à votre question on utilise Excel 2007 et pour le numéro incrémenté il doit repartir à zéro au premier janvier de chaque année.
merci encore une fois et au plaisir de vous lire.

**78chris** · 12/12/2019, 23h47

Bonjour

Donc avec 2007 reste VBA...

**loulah** · 23/12/2019, 23h25

Messieurs,
C’est noël, faites cadeau de votre aide.
Bonne et heureuse année 2020

**BENNASR** · 24/12/2019, 11h09

BONJOUR
Je présente tous mes sincères vœux de bonheur pour 2020 pour toutes et tous
Voila une tentative de réponse à bien tester et revenir pour dire si ça te convient ou non
NB : ce n'est qu'une réponse d'un autodidacte qui nécessite de l'amélioration des grands Messieurs et dames du site
Code pour ceux qui n'ouvre pas les PJ

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
Sub regroup()
Application.ScreenUpdating = False
Dim F1 As Worksheet
Dim F2 As Worksheet
Dim F3 As Worksheet
Set F1 = Sheets("Tableau I")
Set F2 = Sheets("Tableau II")
Set F3 = Sheets("Resultat")
Dim LigneF3 As Long
LigneF3 = F3.Cells(Rows.Count, 3).End(xlUp).Row
If LigneF3 > 1 Then F3.Range("A2 : M" & LigneF3).ClearContents
 
Dim i As Long
Dim L As Integer
L = 2
    '**********************************************************
    TblBD = F2.Range("A2:F" & F2.Range("F" & Rows.Count).End(xlUp).Row)
    For i = 1 To UBound(TblBD)
    F3.Cells(L, 1) = L - 1
    F3.Cells(L, 1).NumberFormat = "0000"
    F3.Cells(L, 3) = TblBD(i, 1)
    F3.Cells(L, 4) = TblBD(i, 2)
    F3.Cells(L, 5) = TblBD(i, 3)
    F3.Cells(L, 11) = TblBD(i, 4)
    F3.Cells(L, 12) = TblBD(i, 5)
    F3.Cells(L, 13) = TblBD(i, 6)
   L = L + 1
    Next i
 Dim LigneF1 As Long
 Dim J As Long
 LigneF1 = F1.Range("B" & Rows.Count).End(xlUp).Row
 LigneF3 = F3.Cells(Rows.Count, 3).End(xlUp).Row
With F3
On Error Resume Next
For J = 2 To LigneF3
.Cells(J, 6) = WorksheetFunction.VLookup(.Cells(J, 4), F1.Range("E2:M" & LigneF1), 5, 0)
.Cells(J, 6) = WorksheetFunction.VLookup(.Cells(J, 5), F1.Range("F2:M" & LigneF1), 4, 0)
.Cells(J, 7) = WorksheetFunction.VLookup(.Cells(J, 4), F1.Range("E2:M" & LigneF1), 6, 0)
.Cells(J, 7) = WorksheetFunction.VLookup(.Cells(J, 5), F1.Range("f2:M" & LigneF1), 5, 0)
.Cells(J, 8) = WorksheetFunction.VLookup(.Cells(J, 4), F1.Range("E2:M" & LigneF1), 7, 0)
.Cells(J, 8) = WorksheetFunction.VLookup(.Cells(J, 5), F1.Range("f2:M" & LigneF1), 6, 0)
.Cells(J, 9) = WorksheetFunction.VLookup(.Cells(J, 4), F1.Range("E2:M" & LigneF1), 8, 0)
.Cells(J, 9) = WorksheetFunction.VLookup(.Cells(J, 5), F1.Range("f2:M" & LigneF1), 7, 0)
.Cells(J, 10) = WorksheetFunction.VLookup(.Cells(J, 4), F1.Range("E2:M" & LigneF1), 9, 0)
.Cells(J, 10) = WorksheetFunction.VLookup(.Cells(J, 5), F1.Range("f2:M" & LigneF1), 8, 0)
Next J
 End With
 
 'Attribution des ATD *****************************************************************************
 ANNEE = Year(Date)
 Set mondico = CreateObject("Scripting.Dictionary")
  i = 1
  For Each c In F3.Range([d2], [d65000].End(xlUp))
    temp = c.Value & c.Offset(, 1).Value
    If Not mondico.exists(temp) Then
       mondico(temp) = i
       i = i + 1
    End If
    c.Offset(, -2) = Format(mondico.Item(temp), "0000") & "/" & ANNEE
  Next c
 
Application.ScreenUpdating = True
F3.Select
End Sub

**loulah** · 27/12/2019, 23h07

Bonsoir tout le monde, j’espère que tout va bien.
Merci beaucoup BENNASR pour votre aide précieuse. Permettez-moi d’émettre quelques suggestions :

Avoir la possibilité de choisir les redevables du tableau I qui vont faire l’objet d’ATD, du genre de la ligne X à la ligne Y puis de la ligne Z à la ligne W ;
Avoir la possibilité de choisir le numéro de la première ATD ;
Par exemple : Le résultat obtenu doit tenir compte de ces données ;
Le résultat de l’extraction doit faire sortir seulement les redevables du tableau I qui ont un compte au tableau II, et aucun autre nom du tableau II.

Encore une fois merci beaucoup pour votre aide et surtout n’oublier pas que 2020 EST L’ANNÉE DU BONHEUR ET DE LA PROSPÉRITÉ, alors profiter en.

**BENNASR** · 30/12/2019, 09h09

bonjour

n’oublier pas que 2020 EST L’ANNÉE DU BONHEUR ET DE LA PROSPÉRITÉ, alors profiter en.

la prospérité est atteint qu'avec la persévérance et la chance n'est que pour ceux qui l’évoquent

2020 = Une année de plus qui s'est écoulé de notre courte vie (pourquoi la fête alors !!!)
c'est nous qui devons changer et non pas les années !!!
Revenons-en à nos moutons :
Je modifier le code pour ne prendre compte que des contribuables qui ont un compte bancaire, :
il suffit d'ajouter si colonne 6 du tableau différent de vide ( If TblBD(i, 6) <> "" Then .......... end if)
Le reste est à discuter pour comprendre la finalité de ton traitement
Remarque : j'insiste et je renouvelle ma demande pour comprendre le code et demander des éclaircissements si c'est nécessaire car formuler votre demande et revenir après 4 à 5 jours pour voir le résultat n'est jamais le but de ce forum

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
Set F3 = Sheets("Resultat")
Dim LigneF3 As Long
LigneF3 = F3.Cells(Rows.Count, 3).End(xlUp).Row
If LigneF3 > 1 Then F3.Range("A2 : M" & LigneF3).ClearContents
 
Dim i As Long
Dim L As Integer
L = 2
    '**********************************************************
    TblBD = F2.Range("A2:F" & F2.Range("F" & Rows.Count).End(xlUp).Row)
    For i = 1 To UBound(TblBD)
    If TblBD(i, 6) <> "" Then
    F3.Cells(L, 1) = L - 1
    F3.Cells(L, 1).NumberFormat = "0000"
    F3.Cells(L, 3) = TblBD(i, 1)
    F3.Cells(L, 4) = TblBD(i, 2)
    F3.Cells(L, 5) = TblBD(i, 3)
    F3.Cells(L, 11) = TblBD(i, 4)
    F3.Cells(L, 12) = TblBD(i, 5)
    F3.Cells(L, 13) = TblBD(i, 6)
   L = L + 1
   End If
    Next i
 Dim LigneF1 As Long
 Dim J As Long
 LigneF1 = F1.Range("B" & Rows.Count).End(xlUp).Row
 LigneF3 = F3.Cells(Rows.Count, 3).End(xlUp).Row
With F3
On Error Resume Next
For J = 2 To LigneF3
.Cells(J, 6) = WorksheetFunction.VLookup(.Cells(J, 4), F1.Range("E2:M" & LigneF1), 5, 0)
.Cells(J, 6) = WorksheetFunction.VLookup(.Cells(J, 5), F1.Range("F2:M" & LigneF1), 4, 0)
.Cells(J, 7) = WorksheetFunction.VLookup(.Cells(J, 4), F1.Range("E2:M" & LigneF1), 6, 0)
.Cells(J, 7) = WorksheetFunction.VLookup(.Cells(J, 5), F1.Range("f2:M" & LigneF1), 5, 0)
.Cells(J, 8) = WorksheetFunction.VLookup(.Cells(J, 4), F1.Range("E2:M" & LigneF1), 7, 0)
.Cells(J, 8) = WorksheetFunction.VLookup(.Cells(J, 5), F1.Range("f2:M" & LigneF1), 6, 0)
.Cells(J, 9) = WorksheetFunction.VLookup(.Cells(J, 4), F1.Range("E2:M" & LigneF1), 8, 0)
.Cells(J, 9) = WorksheetFunction.VLookup(.Cells(J, 5), F1.Range("f2:M" & LigneF1), 7, 0)
.Cells(J, 10) = WorksheetFunction.VLookup(.Cells(J, 4), F1.Range("E2:M" & LigneF1), 9, 0)
.Cells(J, 10) = WorksheetFunction.VLookup(.Cells(J, 5), F1.Range("f2:M" & LigneF1), 8, 0)
Next J
 End With
 
 'Attribution des ATD *****************************************************************************
 ANNEE = Year(Date)
 Set mondico = CreateObject("Scripting.Dictionary")
  i = 1
  For Each c In F3.Range([d2], [d65000].End(xlUp))
    temp = c.Value & c.Offset(, 1).Value
    If Not mondico.exists(temp) Then
       mondico(temp) = i
       i = i + 1
    End If
    c.Offset(, -2) = Format(mondico.Item(temp), "0000") & "/" & ANNEE
  Next c
 
Application.ScreenUpdating = True
F3.Select
End Sub

Bonne continuation

**loulah** · 02/01/2020, 02h32

Bonsoir
Tout d’abord je tiens à préciser que mes connaissances en informatique sont limitées. Chaque fois que j’ai un besoin (notamment avec Excel 2007 que j’utilise beaucoup), je cherche sur les sites spécialisés pour trouver une solution qui se développe avec le temps. Donc on peut dire que je suis autodidacte (merci google). Mais là je suis coincé vue que j’ai fait la connaissance de VBA que récemment à travers les macros et les filtres avancés.
Pour revenir à ma requête, actuellement une collègue à moi travail sur un fichier volumineux composé de deux tableaux. Notre approche actuelle est le ciblage du redevable (tableau I) par le biais de RECHERCHEV puis l’extraction des RIB par établissement bancaire (tableau II) par un filtre avancé. Et enfin la fusion des données dans un troisième tableau qui va constituer la source pour les lettres ATD par procéder publipostage (le numéro d’ATD est ajouté manuellement).
Et ce qui rend la tâche encore plus contraignante : les deux tableaux sont dynamiques, ils changent périodiquement.
Donc, à mon humble avis, la solution consiste à trouver un moyen d’extraire les données d’un ou de plusieurs redevables désignés d’avance par le choix du numéro d’ordre correspondant des deux tableaux à la fois.
J’ai essayé le nouveau code que vous avez gentiment publié mais j’obtiens le message d’erreur suivant :
'**********************************************************
TblBD = F2.Range("A2:F" & F2.Range("F" & Rows.Count).End(xlUp).Row)

Merci de m’aider comprendre ce message de débogage et de trouver une solution.
Merci pour votre temps et votre patience.

**BENNASR** · 02/01/2020, 08h51

bonjour et bonne année 2020

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
Sub regroup()
Application.ScreenUpdating = False
Dim F1 As Worksheet
Dim F2 As Worksheet
Dim F3 As Worksheet
Set F1 = Sheets("Tableau I")
Set F2 = Sheets("Tableau II")
Set F3 = Sheets("Resultat")
Dim LigneF3 As Long
LigneF3 = F3.Cells(Rows.Count, 3).End(xlUp).Row
If LigneF3 > 1 Then F3.Range("A2 : M" & LigneF3).ClearContents
 
Dim i As Long
Dim L As Integer
L = 2
    '**********************************************************
    TblBD = F2.Range("A2:F" & F2.Range("F" & Rows.Count).End(xlUp).Row)

' TblBD : un tableau nommé TblBD qui existe dans F2 alors il existe dans l'onglet nommé Tableau II (voir déclaration ci haut) et qui commence de A2 jusqu'à la dernière ligne non vide de la colonne M
vérifiez si votre tableau répond à ces conditions de même merci de vérifier le nom de chaque onglet
Vous pouvez tester quelques lignes de tes données sur le fichier joint
revenir pour dire si ça te convient pour passer à la suite de votre demande
Cordialement

**loulah** · 06/01/2020, 01h27

Bonsoir tout le monde,
Après essai je peux dire que le résultat est vraiment très encourageant. Si vous le permettez j’ai cependant quelque remarques/suggestions :
1. L’existence de noms sans créances fausse la numérotation des ATD ;
2. Avant d’affecter un numéro d’ATD, est-ce qu’on peut faire un tri au niveau du montant principal pour avoir un classement des redevables du plus grand au plus petit ;
3. Est-ce qu’il est possible de faire une extraction sélective.
Merci pour votre aide et à bientôt.
ci-joint une capture d’écran du fichier en question.

**BENNASR** · 06/01/2020, 08h59

bonjour mon ami, bonjour la forum
Déposer une demande et revenir après 4 ou 5 jours ou même plus au point parfois j'oublie la demande et aussi la solution proposée se qui m'oblige à relire à nouveau !!

Bref :

L’existence de noms sans créances fausse la numérotation des ATD ;

: normalement corrigé et les lignes avec un montant vide sont supprimées avant l'attribution des ATD

2. Avant d’affecter un numéro d’ATD, est-ce qu’on peut faire un tri au niveau du montant principal pour avoir un classement des redevables du plus grand au plus petit ;

: normalement fait et le code fait le trie avant l'affectation des ATD

3. Est-ce qu’il est possible de faire une extraction sélective.

: je crois que vous pouvez faire une copie coller à la main de la partie que vous voulez traiter c-à-d chaque vois vous copier une partie de ta base de donnée et la coller dans la feuille TABLEAU 1 et faire le traitement et ainsi de suite
J'espère que j'ai arrivé à satisfaire votre cahier de charge ....à toi de virer, et dans les plus brefs délais, la somme due chez mon compte courant bancaire ouvert chez la banque sous le numéro 000000000000000001

Tester avec prudence je reste toujours un autodidacte !!

**loulah** · 07/01/2020, 14h09

Bonjour le Forum,
Merci beaucoup si BENNASR, en guise de remerciement (de virement) tout mon respect et ma gratitude. Vous m’avez gratifié tout au long de notre collaboration de votre générosité. Je n’oublierai jamais cette attitude noble. Et je vous assure que cet esprit d’entraide va continuer son bon chemin.
Merci encore une fois et au plaisir de vous lire.

**BENNASR** · 07/01/2020, 14h17

Bonsoir ami, la forum
Toujours le bienvenu mon ami
Merci de cliquer sur RESOLU en bas si c'est le cas
Bonne continuation

Extraction des données de deux tableaux distincts

Macros et VBA Excel

Discussions similaires

Partager

Partager