Separer texte en colonne et compare 2 fichiers
Bonjour,
Je souhaiterais ecrire une macro avec un bouton (sur lequel je clique pour lancer la macro) qui me permet de separer le texte que j'ai dans mes cases excels en colonne, la liste de mots que j'ai sont separes par des virgules
Exemple:
1 Id, Price,Qty etc..
2 1,10,3 etc..
3 2,20,5 etc..
Resultat avec les valeurs: Id Price Qty respectivement dans les case excels A1, B1 et C1 et les valeurs 1,10,3 respectivement dans les cases B1,B2 et C2 etc..
A B C
1 Id Price Qty
2 1 10 3
3 2 20 5
Le fichier excel a des lignes 1 a 1192 mais je souhaiterais utiliser une boucle "Tant Que" svp
Ensuite je souhaiterais comparer les contenu des cases B2 jusqu'a a la derniere case non vide du fichier dataset1 (ici c'est K2) a la case A2 jusqu'a a la derniere case non vide du fichier dataset2 (ici c'est J2) et si les 2 lignes sont egales notez 1 tout a droite du fichier dans une colonne resultat du fichier dataset 1 (ici c'est L2) et faire de meme pour toutes les lignes du fichier qui sont non vides
Exemple:
fichier dataset1
1 Id, Price,Qty,Date,Time etc..
2 1,10,3,14012019,23:25:14 etc..
3 2,20,5,14012019,23:26:14 etc..
etc..
fichier dataset2
1 Price,Qty,Date,Time etc..
2 10,3,14012019,23:25:14 etc..
3 20,5, 14012019,23:26:14 etc..
etc..
Merci d'avance pour votre aide
Bonjour,
La fonction principale dont tu vas avoir besoin, c'est la fonction Split(Expression As String, [Delimiter], [Limit As Long = -1], [Compare As VbCompareMethod = vbBinaryCompare])
Membre de VBA.Strings
Elle permet de retourner un tableau, qui est le résultat d'une séparation de valeurs avec un délimiteur, ici ce sera ","
Avec cette fonction tu pourras répartir tes données sur plusieurs colonnes et ainsi continuer sur ta macro de comparaison.
Tu peux aussi utiliser StrComp(String1, String2, [Compare As VbCompareMethod = vbBinaryCompare])
pour comparer deux chaînes de texte, tu pourras ainsi voir si les cellules sont les mêmes ou non, sinon avec un test "=" ça doit fonctionner aussi je pense.
Bonjour
Du coup ca donne pour le split:
Do while Range(A&i) =! " "
Split(Range(A & i), [,], [Limit As Long = -1], [Compare As VbCompareMethod = vbBinaryCompare])
i=i+1
Loop
Puis pour la comparaison :
Do while Range(A&i) =! " "
StrComp(Dataset1.Sheet1.Range(A&i), Dataset2.Sheet1.Range(A&i), [Compare As VbCompareMethod = vbBinaryCompare])
Loop
C'est bien ca ?
Merci d'avance
Bonjour,
La fonction principale dont tu vas avoir besoin, c'est la fonction Split(Expression As String, [Delimiter], [Limit As Long = -1], [Compare As VbCompareMethod = vbBinaryCompare])
Membre de VBA.Strings
Elle permet de retourner un tableau, qui est le résultat d'une séparation de valeurs avec un délimiteur, ici ce sera ","
Avec cette fonction tu pourras répartir tes données sur plusieurs colonnes et ainsi continuer sur ta macro de comparaison.
Tu peux aussi utiliser StrComp(String1, String2, [Compare As VbCompareMethod = vbBinaryCompare])
pour comparer deux chaînes de texte, tu pourras ainsi voir si les cellules sont les mêmes ou non, sinon avec un test "=" ça doit fonctionner aussi je pense.
Bonjour,
Non, ça ressemble plus à ça:
Sub test()
der_lig = Range("a" & Rows.Count).End(xlUp).Row
Dim tableau As Variant, extract As Variant, tableau1 As Variant, tableau2 As Variant
Dim Ws As Worksheet, Ws1 As Worksheet, Ws2 As Worksheet
Dim identique As Boolean
'Retraitement des données
Set Ws = Workbooks("Dataset1").Sheets(1)
GoSub traitement
Set Ws = Workbooks("Dataset2").Sheets(1)
GoSub traitement
Set Ws = Nothing
tableau = ""
'Comparaison
Set Ws1 = Workbooks("Dataset1").Sheets(1)
Set Ws2 = Workbooks("Dataset2").Sheets(1)
tableau1 = Ws1.Range("a1", Ws1.Cells(Ws1.Range("a" & Rows.Count).End(xlUp).Row, Ws1.Cells(1, Columns.Count).End(xlToLeft).Column + 1))
tableau2 = Ws2.Range("a1", Ws2.Cells(Ws2.Range("a" & Rows.Count).End(xlUp).Row, Ws2.Cells(1, Columns.Count).End(xlToLeft).Column))
For i = LBound(tableau1, 1) To UBound(tableau1, 1)
identique = True
For j = LBound(tableau1, 2) To UBound(tableau1, 2) - 1
If Not StrComp(tableau1(i, j), tableau2(i, j), vbBinaryCompare) = 0 Then
identique = False
End If
Next j
If identique Then
tableau(i, UBound(tableau1, 2)) = 1
End If
Next i
Ws1.Range("a1", Cells(UBound(tableau1, 1), UBound(tableau1, 2))) = tableau1
Exit Sub
'Sous-programme de traitement des données
traitement:
With Ws
For i = 1 To der_lig
extract = Split(Range("A" & i), ",")
If i = 1 Then
ReDim tableau(1 To der_lig, 1 To UBound(extract, 1) + 1)
End If
For j = 0 To UBound(extract, 1)
tableau(i, j + 1) = extract(j)
Next j
Next i
Range("a1", Cells(der_lig, UBound(tableau, 2))) = tableau
End With
Return
End Sub
Les fichiers:
Il faut qu'ils soient tous les deux ouverts pour que ça fonctionne.
Merci
Comment je dois faire pour executer la macro depuis la feuille excel dataset1 ?
J'ai un
"run-time error '9'
Subscript out of range"
quand je clique sur le play depuis le mode developpeur
Merci
Bonjour,
tu peux l'appeler via le bouton qui s'appelle macro dans l'onglet "Développeur", tu cliques sur test et ça commencera
Je viens d'essayer de cliquer sur test depuis la feuille dataset1 que tu m'as mis en piece jointe
J'ai un
"run-time error '9'
Subscript out of range"
J'ai bien ouvert dataset1 et dataset2 avant de lancer la macro
Ca doit compiler tel quel des que j'ouvre ton fichier c'est bien ca ?
Rebonjour,
Je dois avouer être supris, je viens de retrouver des erreurs que j'avais normalement corrigé, visiblement, je n'ai pas dû enregistrer ces modifications, du coup je t'ai envoyé un code bugué... Désolé
Maintenant j'ai enregistré, et ça marche
Je joins les fichiers:
PS: Ce n'est pas un décalage de ligne que tu verras avec les 1, c'est juste que je compare aussi les en-têtes.
J'ai toujours la meme erreur
C'est bien la macro test que je dois lancer depuis la feuille dataset1 ?
Merci d'avance
Rebonjour,
Bizarre! Moi ça marche avec les 2 classeurs ouverts en modification..
Oui il faut bien lancer la macro test dans l'un des 2 fichiers
J'ai testé en étante sur le fichier Dataset2, et ça me faisait un souci, je testais toujours sur DataSet1...
Du coup encore un bug de corrigé, cette fois ça marche sur les 2!
Merci de ta patiente
Hello,
Desole mais j'ai encore la meme erreur
J'ai un
"run-time error '9'
Subscript out of range"
Est ce que c'est par ce que quand j'ouvre mes deux fichiers les feuilles s’appellent "Feuil1" et "Feuil2" et non Sheets(1) ?
Quand je clique sur debug j'ai la ligne ** qui s'affiche en jaune ci dessous
'Retraitement des données
**Set Ws = Workbooks("Dataset1").Sheets(1)
GoSub traitement
Set Ws = Workbooks("Dataset2").Sheets(1)
GoSub traitement
Set Ws = Nothing
tableau = ""
Merci d'avance
Bonjour,
Oui c'est pour ça, j'avais prévu que les feuilles soient les premières de chaque fichier, d'où le Sheets(1), pour l'adapter à ton cas il faudrait par exemple remplacer les Sheets(1) par les noms des feuilles, je te laisse faire cette modification et réessayer?
J'ai toujours la meme erreur
Ca marche chez toi juste quand tu lances la macro test sans rien faire d'autre ?
Rebonjour,
Oui, avec les fichiers que je t'ai donné, j'ai juste besoin de les ouvrir, activer la modification, et lancer le programme, après j'ai les colonnes qui se séparent et les 1 qui apparaissent dans le fichier Dataset1, c'est vraiment bizarre que ça ne fonctionne toujours pas chez toi, je n'ai plus aucun bug moi
Quand tu ajoutes un espion sur tes valeurs, est-ce qu'il trouve le workbooks("Dataset1")?
Deux raisons possibles pour que ça ne marche pas, il ne trouve pas Workbooks("Dataset1"), ou bien il ne trouve pas Sheets(1), je vais essayer de te retourner une version avec des feuilles nomées correctement qui se font appelées par leur nom pour voir si ça arrange ton bug...
Re,
Une version modifiée avec des noms explicites:
Attention si tu enregistres, ça rajoute Copie de, ça fera planter les programmes si les noms ne sont pas Dataset1 et Dataset2, les feuilles sont appelées par leur nom, il ne peut pas y avoir de bug de ce côté là normalement, j'ai testé chez moi et ça fonctionne, j'espère que tu pourras enfin voir le résultat de la macro
Merci
Ca ne marche toujours pas
J'ai la meme erreur
Ca doit venir de mon excel
J'ai bien fait attention aux noms de sheets
Mince alors!
Dernier essai avant qu'on ne fasse un post pour demander de l'aide aux membres du forum sur un autre sujet
Pourras-tu me transmetre les fichiers qui ne fonctionnent pas, quand tu les télécharges?
Voici le code que j'ai en ce moment pour que tout le monde puisse le voir sans avoir a ouvrir le fichier, merci
Sub test()
der_lig = Range("a" & Rows.Count).End(xlUp).Row
Dim tableau As Variant, extract As Variant, tableau1 As Variant, tableau2 As Variant
Dim Ws As Worksheet, Ws1 As Worksheet, Ws2 As Worksheet
Dim identique As Boolean
'Data Reprocessing
Set Ws = Workbooks("Dataset1").Sheets("Feuille dataset1")
GoSub traitement
Set Ws = Workbooks("Dataset2").Sheets("Feuille dataset2")
GoSub traitement
Set Ws = Nothing
tableau = ""
'Comparaison
Set Ws1 = Workbooks("Dataset1").Sheets("Feuille dataset1")
Set Ws2 = Workbooks("Dataset2").Sheets("Feuille dataset2")
tableau1 = Ws1.Range("a1", Ws1.Cells(Ws1.Range("a" & Rows.Count).End(xlUp).Row, Ws1.Cells(1, Columns.Count).End(xlToLeft).Column + 1))
tableau2 = Ws2.Range("a1", Ws2.Cells(Ws2.Range("a" & Rows.Count).End(xlUp).Row, Ws2.Cells(1, Columns.Count).End(xlToLeft).Column))
For i = LBound(tableau1, 1) To UBound(tableau1, 1)
identique = True
For j = LBound(tableau1, 2) To UBound(tableau1, 2) - 1
If Not StrComp(tableau1(i, j), tableau2(i, j), vbBinaryCompare) = 0 Then
identique = False
End If
Next j
If identique Then
tableau1(i, UBound(tableau1, 2)) = 1
End If
Next i
Ws1.Range("a1", Ws1.Cells(UBound(tableau1, 1), UBound(tableau1, 2))) = tableau1
Exit Sub
'Data Processing Subprogram
traitement:
With Ws
For i = 1 To der_lig
extract = Split(.Range("A" & i), ",")
If i = 1 Then
ReDim tableau(1 To der_lig, 1 To UBound(extract, 1) + 1)
End If
For j = 0 To UBound(extract, 1)
tableau(i, j + 1) = extract(j)
Next j
Next i
.Range("a1", .Cells(der_lig, UBound(tableau, 2))) = tableau
End With
Return
End Sub
Rebonjour,
Merci de ta patiente et d'avoir répondu à ma requête
Encore une fois, ça marche chez moi, à une exception près...
Parfois quand ça m'ouvre le fichier, dans le bandeau en haut ça m'affiche Dataset1 (1) ou Dataset2 (1), et dans ce cas là ça ne marche pas, mais sinon... ça fonctionne si je fais attention aux noms affichés tout en haut de la fenêtre
Ce qu'il restera à faire c'est créer un nouveau sujet dans le forum en demandant aux membres pourquoi tu as cette erreur, ils pourront sûrement mieux te guider que moi sur le paramétrage et le reste, ils ont peut-être déjà eu ce genre de soucis...
Si tu dois refaire ça, je te conseille de mettre le lien du sujet initial, le code, là où ça plante, et préciser que chez moi ça marche afin qu'ils puissent t'aider au mieux.
Bonne journée malgré tout