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

Ausecour a écrit :

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?

Les voici

Merci

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 Je suppose que ce n'est pas ça non plus ton soucis? Pourtant on a la même version... Même configuration... Là je sèche, si ce n'est pas ça qui te fait planter, je ne pourrai pas plus t'aider

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