boucle + ecriture

[Xavier]

Rebonjour,


Je cherche actuellement à faire ceci:

Une boucle qui me permettrait de comparer deux colonnes dans deux fichiers distincts (A et B), de telle manière que si A.Cellule = B.Cellule (au niveau du contenu et non pas de sa position ) alors le macro écrit dans une autre cellule de A le contenu d'une cellule x du fichier B ...

Mon plus gros problème réside dans la programmation de la boucle vu que je n'en ai jamais fait ...

Merci bcp
xa

 

[@+Thierry]

Bonjour Xavier, le Forum

Avec le peu de détail que tu as donné, j'espère que ce code te conviendra.

En résumé... Ce code va analyser deux colonnes "A" situées sur deux feuilles nomées "FeuilleA" et "FeuilleB" lesquelles sont chacune dans deux classeurs différents "LeClasseurA.xls" et le "LeClasseurB.xls" (Il est donc, bien entendu, subordonné que ces deux classeurs existent avec les deux Feuilles, et sont bien Ouverts au moment du lancement de cette macro, sinon Boum ! lol)

Donc cette procédure va faire l'analyse et reporter en colonne "B" en face de chaque Item de la "FeuilleA"(WSSource) du Classeur Source (WBSource) les Items identiques qui auront été identifiés en "FeuilleB" (WSCible) du Classeur Cible (WBCible)... En prime en colonne "C" je mets aussi l'adresse de la cellule "Cible"...

Option Explicit

Sub CompareTwoFiles()
Dim WBSource As Workbook, WBCible As Workbook
Dim WSSource As Worksheet, WSCible As Worksheet
Dim PlageSource As Range, PlageCible As Range
Dim CellSource As Range, CellCible As Range

Set WBSource = Workbooks("LeClasseurA.xls")
Set WSSource = WBSource.Sheets("FeuilleA")

Set WBCible = Workbooks("LeClasseurB.xls")
Set WSCible = WBCible.Sheets("FeuilleB")

With WSSource
  Set PlageSource = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

With WSCible
  Set PlageCible = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

    For Each CellSource In PlageSource
       For Each CellCible In PlageCible
         If CellSource = CellCible Then
          With CellSource
           .Offset(0, 1) = CellCible.Value
           .Offset(0, 2) = CellCible.Address
          End With
         End If
       Next CellCible
    Next CellSource

End Sub

Voilà pour le "Moteur" de deux boucles imbriquées... Je ne connais pas ton niveau de compétance VBA, mais c'est le plus simple que je puisse te proposer, par contre si tes tableaux de données sont très grands, ce genre de code peut "mouliner" un certain temps... Sinon il faut passer par des Dynamic Array au lieu de travailler sur les Plages, mais c'est plus avancé comme niveau...

Bonne Soirée
@+Thierry

 

[Jean-Marie]

Bonsoir Xavier, Thierry

Comme Thierry te l'avait suggéré dans son fil, voici un code avec l'utilisation de tableaux, la gestion des doublons des valeurs du FichierA/FichierB, et aussi dans la même colonne du fichier A est géré par l'object collection.

Change les références des plages de données (en gras) pour les adapter à ton cas.

Public Sub CopieAetBsansDoublon()
Dim vColA As Variant 'Tableau dynamique, la longueur est liée à la plage à définir dans le code
Dim vColB As Variant 'Tableau dynamique, la longueur est liée à la plage à définir dans le code
Dim vConnu As New Collection 'Tableau de résultat sans doublons
Dim I As Long, J As Long, L As Long 'Variable de boucle

'On détermine la plage des cellules du 1er fichier A et on bascule les données dans le tableau
With Workbooks("FichierA").Worksheets("Feuil1")
vColA = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

'On détermine la plage des cellules du 1er fichier B et on bascule les données dans le tableau
With Workbooks("FichierB").Worksheets("Feuil1")
vColB = .Range("B1:B" & .Range("A65536").End(xlUp).Row)
End With

'L'utilisation de l'objet New Collection et d'une clé unique nécessite une gestion d'erreur
On Error Resume Next

For I = 1 To UBound(vColA, 1) 'On prend une valeur du Tableau A
For J = 1 To UBound(vColB, 1) 'On prend une valeur du Tableau B
' On fait une comparaison de ces deux valeurs
If vColA(I, 1) = vColB(J, 1) Then
'La valeur comparée doit être placé dans le fichier C
vConnu.Add Item:=vColB(J, 1), key:=CStr(vColB(J, 1))
End If
Next J
Next I

'Ecriture dans le fichier C
With Workbooks("FichierC").Worksheets("Feuil1")
For L = 1 To vConnu.Count
.Cells(L, 3) = vConnu(L)
Next L
End With
End Sub

@+Jean-Marie

 

[@+Thierry]

=> Exercices sur Tableau Indéxés Séquentiellement (Dynamic Array) ;-)

Bonjour Jean-Marie, Xavier, le Forum

J'espère que Xavier n'a pas eu un évanouissement en voyant ce code Jean-Marie !

Bon sinon je suppose que tu as travaillé en test sans enregistrer tes classeurs et que tu as renommé ceux-ci pour le Post "FichierA", "FichierB" & "FichierC"... Car sous PC pour un fichier enregistré il faut préciser l'extention Workbooks("FichierA.xls") sinon y a pas bon (ou alors encore une différence Mac)

Pour le reste c'est tout OK, sauf que l'on part un peu plus loin que la demande de Xavier avec un troisième classeur ne reportant que les items étant en doublon, mais il est fort probable que celà lui sera utile.

Par contre je ne suis pas d'accord sur la dénomination "'Tableau dynamique" pour les "vColA" et "vColA", car là ça peut porter à confusion... En effet entre l'anglais "Dynamic Array" et "Tableau Dynamique" on pourrait penser que c'est idem, alors que "Dynamic Array" serait plutôt en français "Tableau Indéxé Séquentiellement", et là les vColA & vColB sont des Tableaux tout simple reflétant des plages (Array), même si ces plage sont dimensionnées dynamiquement (end(xlUp)... Enfin ce n'est vraiment pas important, c'est juste dans un soucis de précision pour éviter des confusions.

Et tant que l'on parle de Dynamic Arrays, donc de "Tableau Indéxés Séquentiellement", alors voici deux Procédures pour exactement le même résultat que mon code plus haut qui travaillait sur les Objets Ranges(probablement 100 fois plus rapide sur des gros gros tableaux)


Public Sub CompareTwoFilesDynamicArraySimple()
Dim TabA As Variant 'Tableau (Array) liée à la plage à définir dans le code
Dim TabB As Variant 'Tableau (Array) liée à la plage à définir dans le code
Dim TabDynamicArray() As String 'Tableau indexé séquentiellement (Dynamic Array)
Dim I As Long, J As Long

'On détermine la plage des cellules du 1er fichier A et on bascule les données dans le tableau
With Workbooks("FichierA.xls").Worksheets("Feuil1")
 TabA = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

'On détermine la plage des cellules du 1er fichier B et on bascule les données dans le tableau
With Workbooks("FichierB.xls").Worksheets("Feuil1")
  TabB = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

    For I = 1 To UBound(TabA, 1) 'On prend une valeur du Tableau A

      'Dimensionnement & Construction du Tableau Dynamique Première Colonne (tous les Items)
      ReDim TabDynamicArray(UBound(TabA), 2)
        TabDynamicArray(I - 1, 0) = TabA(I, 1)

         For J = 1 To UBound(TabB, 1) 'On prend une valeur du Tableau B

            'On fait une comparaison de ces deux valeurs
            If TabA(I, 1) = TabB(J, 1) Then
            'Suite Construction du Tableau Dynamique Seconde Colonne (les Items communs)
              TabDynamicArray(I - 1, 1) = TabB(J, 1)
            End If

         Next J
    Next I

'Ecriture dans le FichierA avec report integral du Tableau Dynamique
With Workbooks("FichierA.xls").Worksheets("Feuil1")
  .Range("A1:B" & .Range("A65536").End(xlUp).Row) = TabDynamicArray
End With

End Sub




Public Sub CompareTwoFilesDynamicArrayAdvanced()
Dim TabA As Variant 'Tableau (Array) liée à la plage à définir dans le code
Dim TabB As Variant 'Tableau (Array) liée à la plage à définir dans le code
Dim TabDynamicArray() As String 'Tableau indexé séquentiellement (Dynamic Array)
Dim TabDynamicArrayInOrder() As String 'Tableau indexé séquentiellement (Dynamic Array)
Dim I As Long, J As Long, L As Long 'Variable de boucle
Dim x As Long 'Variable d'Indexation séquentielle

'On détermine la plage des cellules du 1er fichier A et on bascule les données dans le tableau
With Workbooks("FichierA.xls").Worksheets("Feuil1")
  TabA = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

'On détermine la plage des cellules du 1er fichier B et on bascule les données dans le tableau
With Workbooks("FichierB.xls").Worksheets("Feuil1")
  TabB = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

    For I = 1 To UBound(TabA, 1) 'On prend une valeur du Tableau A

    ''Dimensionnement Construction du Tableau Dynamique Première Colonne (tous les Items)
    ReDim Preserve TabDynamicArray(2, x)
    TabDynamicArray(0, x) = TabA(I, 1)

        For J = 1 To UBound(TabB, 1) 'On prend une valeur du Tableau B

        ' On fait une comparaison de ces deux valeurs
          If TabA(I, 1) = TabB(J, 1) Then
           'Suite Construction du Tableau Dynamique Seconde Colonne (les Items communs)
           TabDynamicArray(1, x) = TabB(J, 1)
          End If

        Next J
    x = x + 1 'Incrémentattion du numéro séquentiel
    Next I

   'Le Tableau dynamique est à l'envers, remise à l'endroit (je crois que Zon a une astuce)
   For I = 0 To UBound(TabDynamicArray, 2)
    ReDim Preserve TabDynamicArrayInOrder(UBound(TabDynamicArray, 2), 2)
    TabDynamicArrayInOrder(I, 0) = TabDynamicArray(0, I)
    TabDynamicArrayInOrder(I, 1) = TabDynamicArray(1, I)
   Next I

'Ecriture dans le FichierA avec report integral du Tableau Dynamique à l'endroit
With Workbooks("FichierA.xls").Worksheets("Feuil1")
  .Range("A1:B" & .Range("A65536").End(xlUp).Row) = TabDynamicArrayInOrder
End With

End Sub


La seconde méthode ici n'est pas justifiée puisque l'on connait la dimension à l'avance, mais c'est plus en tant qu'exercice de démostration, par contre donc dans ce second cas on est obligé de construre le tableau séquentiel à l'envers... D'où la nécessité de le remettre à l'endroit... Et je pense que si Zon passe par ici il a une astuce plus efficace que de redescendre et reconstruire le tableau... (il me semble que j'avis vu un barbatruc lol ?)

Bon sinon je croise aussi les doigts pour que la mise en page de ce post passe correctement, car dans cette mini fenêtre c'est illisible lol

Bon App
@+Thierry

PS Sorry Xavier de t'emprunter ton Fil de la sorte, j'espère que tu n'auras pas mal à la tête !

 

[hurricane]

bonjour le fil


oh là là que du bonheur ce @+thierry un rapide CTRL+C, CTRL+V dans ma bibliotheque perso

@+

 

[@+Thierry]

Re: => Exercices sur Tableau Indéxés Séquentiellement (Dynamic Array) ;-)

Bonjour Hurricane, re Jean-Marie, Xavier

Heureux de te revoir parmis nous Hurricane, (pour la petite histoire, Hurricane est "le Papa importateur" dans ce Forum de la methode "New Collection" avec l'erreur générée par le "Key" en double, ce qui permet de "dégager" facilement les doublons d'une base de données (Voir la méthode utilisée par Jean Marie plus haut)

Sinon je reviens pour indiquer que le "Preserve" n'est pas nécessaire dans le seconde méthode, puisque on connait les dimmensions au niveau du second Tableau Séquentiel "TabDynamicArrayInOrder" donc ceci suffit :

For I = 0 To UBound(TabDynamicArray, 2)
ReDim TabDynamicArrayInOrder(UBound(TabDynamicArray, 2), 2)
TabDynamicArrayInOrder(I, 0) = TabDynamicArray(0, I)
TabDynamicArrayInOrder(I, 1) = TabDynamicArray(1, I)
Next I

Sorry on s'y perd vite avec ces tablooo !!
bon aprèm
@+Thierry

 

[Xavier]

Merci bcp mais il parait qu'on peut utiliser la fonction VLOOKUP ... maintenant plus qu'à la comprendre aussi non heu .... la nuit va etre longue pour comprendre vos traits de génie ( la flaterie ca fait toujours du bien ) et transférer dans mon fichier.

Xa

 

[@+Thierry]

Bonjour Xa, re le Fil

Pardon ? la fonction Vlookup, oui of course, mais alors il ne fallait pas demander alors de l'aide sur "la programmation de la boucle" ...

m'enfin !!! lol

De toute manière on s'est bien amusé, hein Jean-Marie ?

Bon Après Midi
@+Thierry

PS : Fais une recherche dans ce Forum à RechercheV... pour ton VlookUp

 

[Xavier]

Rebonjour,

Je m'excuse pour la fonction VLOOKUP on ne dirait pas que ca marche .... alors essayons de comprendre ... mais pouvez vous me dire lequel des deux exemples je dois comprendre .... je commence par celui de @thierry

Merci
Xa

 

[Xavier]

Encore moi ....


J'ai presque tout compris dans le premier code mais voilà


Option Explicit
Sub UserForm1_Initialize()

With CommandButton1
.Caption = "OK"
.Default = True
End With

Private Sub CommandButton2_Click()
Dim Text1 As String
Text1 = Application.GetOpenFilename("Tous les Fichiers Excel(*.xls),*.xls", , "A la recherche des fichiers")
TextBox1.Value = Text1
End Sub

Private Sub CommandButton3_Click()
'Il s'agit du bouton exit"
Unload Me
End Sub

Private Sub CommandButton1_Click()
'Processus de comparaison des ID_level afin de déterminer les KAM
'Pour ce faire, je dois tout d'abord comparer dans mon fichier de base une colonne 'particulière avec un fichier ouvert lors de la procédure du Button2 donc avec text1. 'Ensuite pour chaque cellule correspondante, j'aimerais écrire dans une colonne (E) 'dans mon fichier de base ce qui se trouve dans une cellule qui se trouve sur la meme ligne mais dans une autre colonne de mon fichier annexe (text1)

'Donc lancons nous dans la proposition de comparaison

Dim WBSource As Workbook, WBCible As Workbook
Dim WSSource As Worksheet, WSCible As Worksheet
Dim PlageSource As Range, PlageCible As Range
Dim CellSource As Range, CellCible As Range
Dim Text1 As String

Set WBSource = Workbooks("fichierprincipal")
Set WSSource = WBSource.Sheets("sheet1")
'Là j'aimerai y faire référence au fichier sélectionner précédemment
Set WBCible = Workbooks(Text1)
'Le dataL1 vient du fait que la feuille s'appelle
'toujours comme ca quelque soit le fichier selectionner

Set WSCible = WBCible.Sheets("dataL1")

With WSSource
Set PlageSource = .Range("Z1:Z" & .Range("A65536").End(xlUp).Row)
End With

With WSCible
Set PlageCible = .Range("B1:B" & .Range("A65536").End(xlUp).Row)
End With

For Each CellSource In PlageSource
For Each CellCible In PlageCible
If CellSource = CellCible Then
With CellSource
'là j'avoue que je suis perdu …
'J'aimerais donc écrire dans une cellule de mon fichierprincipal
'le contenu d'une 'cellule (ayant la meme ligne mais pas la meme
'colonne que la CellCible) La colonne serait la E

.Offset(0, 1) = CellCible.Value
.Offset(0, 2) = CellCible.Address
End With
End If
Next CellCible
Next CellSource

End Sub

 

[Jean-Marie]

Re...

Thierry, il y a une chose qui m'échappe, tu as déclaré dans la méthode 1 le tableau TabDynamicArray avec une ligne et une colonne de trop, et dans la méthode 2 ce même tableau à une ligne de trop. L'option Base 1 n'est pas spécifié dans ton module puisque tu affectes le tableau comme ceci TabDynamicArray(I - 1, 0) = TabA(I, 1)

Il doit y avoir un truc mais lequel !!!

J'ai essayé de faire tourné la sub, je me retrouve à avoir une plage de cellule vide ?

Thierry, dire que je m'amuse n'est pas vraiment le terme approprié, disons que je découvre, que j'apprends... lol

@+Jean-Marie

PS, Xavier comme te l'a dit Thierry pardon pour cette intrusion dans ton fil.

 

[Xavier]

Aucun problème si vous y trouvez du plaisir ... y a aucun prob et puis j'apprend aussi un peu ...

 

[Jean-Marie]

Re

J'apprends, j'apprends...
L'instruction redim du tableau était mal placé, il faut la mettre avant la première bloucle, ce qui donne ceci

Public Sub CompareTwoFilesDynamicArraySimple()
Dim TabA As Variant 'Tableau (Array) liée à la plage à définir dans le code
Dim TabB As Variant 'Tableau (Array) liée à la plage à définir dans le code
Dim TabDynamicArray() As String 'Tableau indexé séquentiellement (Dynamic Array)
Dim I As Long, J As Long

'On détermine la plage des cellules du 1er fichier A et on bascule les données dans le tableau
With Workbooks("FichierA.xls").Worksheets("Feuil1")
 TabA = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

'On détermine la plage des cellules du 1er fichier B et on bascule les données dans le tableau
With Workbooks("FichierB.xls").Worksheets("Feuil1")
  TabB = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

      'Dimensionnement & Construction du Tableau Dynamique Première Colonne (tous les Items)
      ReDim TabDynamicArray(UBound(TabA), 2)
    For I = 1 To UBound(TabA, 1) 'On prend une valeur du Tableau A
        TabDynamicArray(I - 1, 0) = TabA(I, 1)

         For J = 1 To UBound(TabB, 1) 'On prend une valeur du Tableau B

            'On fait une comparaison de ces deux valeurs
            If TabA(I, 1) = TabB(J, 1) Then
            'Suite Construction du Tableau Dynamique Seconde Colonne (les Items communs)
              TabDynamicArray(I - 1, 1) = TabB(J, 1)
            End If

         Next J
    Next I

'Ecriture dans le FichierA avec report integral du Tableau Dynamique
With Workbooks("FichierA.xls").Worksheets("Feuil1")
  .Range("A1:B" & .Range("A65536").End(xlUp).Row) = TabDynamicArray
End With

End Sub

@+Jean-Marie

 

[Zon]

Salut,

quand tu parles d'astuce cela n'en ai aps vraiment une:

'Le Tableau dynamique est à l'envers, remise à l'endroit (je crois que Zon a une astuce)
For I = 0 To UBound(TabDynamicArray, 2)
ReDim Preserve TabDynamicArrayInOrder(UBound(TabDynamicArray, 2), 2)
TabDynamicArrayInOrder(I, 0) = TabDynamicArray(0, I)
TabDynamicArrayInOrder(I, 1) = TabDynamicArray(1, I)
Next I

'Ecriture dans le FichierA avec report integral du Tableau Dynamique à l'endroit
With Workbooks("FichierA.xls").Worksheets("Feuil1")
.Range("A1:B" & .Range("A65536").End(xlUp).Row) = TabDynamicArrayInOrder
End With

effectivement au lieu de refaire une boucle, j'écris:
With Workbooks("FichierA.xls").Worksheets("Feuil1")
.Range("A1").resize(ubound(TabDynamicArrayInOrder,2),ubound(TabDynamicArrayInOrder,1) = application.transpose(TabDynamicArrayInOrder)

ATTENTION : application.transpose jusqu'à XL 2002 ne fonctionne que sur 5700 et qques éléments sinon cela renvoie un tableau vide. Je passe alors dans le mêm style de boucles que toi que j'ai mise en fonction pour els tableaux uni et bidimensionnel:

Function InverseTab(T, Optional Base As Byte = 0)
Dim Temp(), I&, J&
ReDim Temp(Base To UBound(T, 2), Base To UBound(T))
For I = LBound(T, 2) To UBound(T, 2)
For J = LBound(T) To UBound(T)
Temp(I, J) = T(J, I)
Next J
Next I
InverseTab = Temp
End Function


Enfin, dans CompareTwoFilesDynamicArraySimple on peut se passer par un tableau supplémentaire et peut être aussi sortir de la boucle une fois l'item trouvé:




Public Sub CompareTwoFilesDynamicArraySimple()
Dim TabA As Variant 'Tableau (Array) liée à la plage à définir dans le code
Dim TabB As Variant 'Tableau (Array) liée à la plage à définir dans le code
Dim TabDynamicArray() As String 'Tableau indexé séquentiellement (Dynamic Array)
Dim I As Long, J As Long

'On détermine la plage des cellules du 1er fichier A et on bascule les données dans le tableau
With Workbooks("FichierA.xls").Worksheets("Feuil1")
TabA = .Range("A1:B" & .Range("A65536").End(xlUp).Row) 'on rajoute une colonne et on est en base 1.

End With

'On détermine la plage des cellules du 1er fichier B et on bascule les données dans le tableau
With Workbooks("FichierB.xls").Worksheets("Feuil1")
TabB = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

For I = 1 To UBound(TabA, 1) 'On prend une valeur du Tableau A


' ça écite cette instruction=>TabDynamicArray(I , 1) = TabA(I, 1)

For J = 1 To UBound(TabB, 1) 'On prend une valeur du Tableau B

'On fait une comparaison de ces deux valeurs
If TabA(I, 1) = TabB(J, 1) Then
Tab(A, 2) = TabB(J, 1)
exit for 'on sort de la boucle sur J une fois l'item trouvé
End If

Next J
Next I

'Ecriture dans le FichierA avec report integral du Tableau Dynamique
With Workbooks("FichierA.xls").Worksheets("Feuil1")
.Range("A1").resize(UBound(TabA, 1),UBound(TabB, 2) = tabA
End With

End Sub


Désolé d'être aussi long . Je continuerais dasn ma page Wiki certaines précisions, passer un tri ....


A+++

Lien supprimé

 

[Zon]

Re,
*
il y a une 1 erreur

.Range("A1").resize(UBound(TabA, 1),UBound(TabB, 2) = tabA à remplacer par
.Range("A1").resize(UBound(TabA, 1),UBound(TabA, 2) = tabA


Inversetab ne foncitonne que sur els tableaux bidimensionnels, c'est celle ci qui foncitonne sur les 2 types:

Function TransposeGrandTab(T) 'Zon
'Application.transpose est limité à 5000 et qques éléments jusqu'à XL2002
Dim Temp, I&, J&, Z As Byte, Nb As Byte
On Error Resume Next
Do
Nb = Nb + 1
Z = UBound(T, Nb + 1)
Loop Until Err
If Nb = 1 Then
ReDim Temp(UBound(T), 1 To 1)
For I = LBound(T) To UBound(T)
Temp(I, 1) = T(I)
Next I
Else
ReDim Temp(1 To UBound(T, 2), 1 To UBound(T, 1))
For I = 1 To UBound(T, 2)
For J = 1 To UBound(T, 1)
Temp(I, J) = T(J, I)
Next J
Next I
End If
TransposeGrandTab = Temp
End Function

A+++