remplissage de colonne suivant plusieur criteres sur lignes dans 2 fichiers

patpat78

XLDnaute Nouveau
Bonjour cela fait quelques temps que je cherche une solution a mon probelme j'ai tester differents codes VBA sans succes

voila mon probleme

j'ai un tableau sur un fichier et un tableau base dans un deuxieme fichier jusque la tout vas bien

ce que je veux faire c'est une macro qui compare les 2 tableaux et qui si une ligne match sur les colonnes D,F,H et L

alors les informations contenu dans le tableau 2 dans les colonnes I et O soient copier dans les tableau 1 aux lignes correspondantes dans les colones I et O


je vous joint les 2 fichiers correspondants pour mieux comprendre

en sachant que la recherche sur le tableau 1 doit commencer a la ligne 10 et s'arreter a la premiere ligne vide

et que le tableau n° 2 ( base) est placeer sur le reseau donc le chemin est invariable et peut etre placer en dur dans la macro si possible sans avoir besoin de l'ouvrir pour l'execution

je vous met donc le fichier 1 ( nomenclature ) et le fichier 2 (base)

merci d'avance
 

Pièces jointes

  • nomenclature.xls
    170 KB · Affichages: 173
  • base.xls
    19 KB · Affichages: 39
  • nomenclature.xls
    170 KB · Affichages: 231
  • base.xls
    19 KB · Affichages: 38
  • nomenclature.xls
    170 KB · Affichages: 228
  • base.xls
    19 KB · Affichages: 34

Yaloo

XLDnaute Barbatruc
Re : remplissage de colonne suivant plusieur criteres sur lignes dans 2 fichiers

Bonsoir Patpat et bienvenu sur XLD,

Peut-être avec une macro comme celle-là, à placer dans le fichier "nomenclature", pour la lancer, il faut que l'autre fichier soit ouvert.

VB:
Option Explicit
Sub recherche()
Dim i&, j&, Dl1&, Dl2&, t1, t2
Dim Wk1 As Workbook, Wk2 As Workbook
Set Wk1 = ThisWorkbook
Set Wk2 = Workbooks("Base.xls")
Dl1 = Wk1.Sheets(1).[A65536].End(xlUp).Row
Dl2 = Wk2.Sheets(1).[D65536].End(xlUp).Row
t1 = Wk1.Sheets(1).Range("A10:O" & Dl1)
t2 = Wk2.Sheets(1).Range("A2:O" & Dl2)
For i = 10 To UBound(t1)
  For j = 2 To UBound(t2)
    If t1(i, 4) & t1(i, 6) & t1(i, 8) & t1(i, 12) = t2(j, 4) & t2(j, 6) & t2(j, 8) & t2(j, 12) Then
      t1(i, 9) = t2(j, 9): t1(i, 15) = t2(j, 15)
    End If
  Next
Next
[A10].Resize(UBound(t1), UBound(t1)) = t1
End Sub

A+

Martial
 

patpat78

XLDnaute Nouveau
Re : remplissage de colonne suivant plusieur criteres sur lignes dans 2 fichiers

bonjour et merci de vous penchez sur mon problème ;)


alors c'est presque parfait j'ai modifier ça
1 = Wk1.Sheets(1).Range("A10:p" & Dl1)
t2 = Wk2.Sheets(1).Range("A2:p" & Dl2)

sinon ça me detruisait la colonne P

par contre ça me rempli sur le classeur nomenclature apres la colonne P toutes les cases avec #N/A ??

ya moyen d'enlever ça?

et dernier truc le fichier base ne doit pas etre ouvert par l'utilisateur car je les connais ils vont aller me le modifié...


ya a il un moyen pour mettre dans la macro le chemin du fichier base quitte a l'ouvrir avec la macro et le refermer quand la comparaison est finie ?


merci beaucoup en tout cas

patpat
 

Yaloo

XLDnaute Barbatruc
Re : remplissage de colonne suivant plusieur criteres sur lignes dans 2 fichiers

Bonjour Patpat,

Vois avec cette macro :

VB:
Option Explicit
Sub recherche()
Dim i&, j&, Dl1&, Dl2&, t1, t2
Dim Wk1 As Workbook, Wk2 As Workbook
Set Wk1 = ThisWorkbook
Workbooks.Open (ThisWorkbook.Path & "\base.xls")
Set Wk2 = Workbooks("Base.xls")
Wk1.Activate
Dl1 = Wk1.Sheets(1).[A65536].End(xlUp)(2).Row
Dl2 = Wk2.Sheets(1).[D65536].End(xlUp).Row
t1 = Wk1.Sheets(1).Range("A10:O" & Dl1)
t2 = Wk2.Sheets(1).Range("A2:O" & Dl2)
Workbooks("base.xls").Close 0
For i = 10 To UBound(t1)
  For j = 2 To UBound(t2)
    If t1(i, 4) & t1(i, 6) & t1(i, 8) & t1(i, 12) = t2(j, 4) & t2(j, 6) & t2(j, 8) & t2(j, 12) Then
      t1(i, 9) = t2(j, 9): t1(i, 15) = t2(j, 15)
    End If
  Next
Next
[A10].Resize(UBound(t1), 15) = (t1)
End Sub

J'en ai profité pour intégrer l'ouverture et la fermeture du fichier base.xls, il faut qu'il se trouve dans le même répertoire que ton fichier nomenclature.

A+

Martial
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 489
Messages
2 088 855
Membres
103 976
dernier inscrit
kaizertv2001@gmailcom