[VBA-E] Problème macro excel

Version imprimable

Voir 40 message(s) de cette discussion en une page

Tu peux déja associer les lignes ou les Prénoms et Noms sont identiques et laisser dans les originaux les non identiques... Compris?

Et l'améliorer en comparant des chaines sans accents, sans majuscules.

cad
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 if CompareM(String1, String2) = 1 then ... end if Function CompareM(String1, String2) if len(String1) = Len(String2) then String1 = Replace(String1,"é", "e") String1 = Replace(String1,"è", "e") String2 = Replace(String1,"é", "e") String2 = Replace(String1,"è", "e") if String1 = String2 then CompareM=1 Else CompareM=0 end if end function
Le code est a optimiser, tu met les caractères accentués dans un tableau a 2 dimenstions et tu fais une boucle...
Code:

1 2 3 4 5 CharToReplace(0,0) = "é" CharToReplace(0,1) = "e" CharToReplace(1,0) = "è" CharToReplace(1,1) = "e" etc...

Déja la fonction de remplacement des accents.

Code:

1
2
3
4
5
6
7
8
9
10
Public Function ReplaceChars(varStringToReplace As String)
  CHAINE_DEPART = "àäâãçéèêëìïîôöòûüùÿÁÀÄÂÃÉÈÊËÍÎÌÔÖÒÓÕÜÛÙÚÝ"
  CHAINE_ARRIVE = "aaaaceeeeiiiooouuyyAAAAAEEEEIIIOOOOOUUUUY"
 
For i = 1 To Len(CHAINE_DEPART)
    varStringToReplace = Replace(varStringToReplace, Mid(CHAINE_DEPART, i, 1), Mid(CHAINE_ARRIVE, i, 1))
Next i
 
ReplaceChars = varStringToReplace
End Function

18/05/2006, 22h06
pontus21

Citation:

Envoyé par Vesta

Tu peux déja associer les lignes ou les Prénoms et Noms sont identiques et laisser dans les originaux les non identiques... Compris?

Et je fais ça comment pour "regrouper", enfin, plutôt cumuler les cellules de mes 2 fichiers ?
18/05/2006, 23h16
ouskel'n'or

Sans connaître la structure de tes données ta question n'aura qu'une réponse vague. Si tu veux quelque chose de précis, donne la structure de tes lignes pour chacune des feuilles que tu veux rassembler.

A+
18/05/2006, 23h45
ouskel'n'or

Juste une indication. Tes feuilles doivent avoir la même structure. Mêmes colonnes, mêmes entêtes (pour les entêtes, c'est mieux)
Les N° de colonnes doivent correspondre pour le même type de données.
Si certaines colonnes n'existent pas dans l'une des feuilles, tu dois la créer, même si elle doit rester vide dans l'une des feuilles.
Une fois ceci fait, tu pourras cumuler les données des deux feuilles.

Tu dis

A+
19/05/2006, 01h44
pontus21

Donc j'ai 2 fichiers excel avec dans le premier, le nom, le prénom + d'autres colonnes (texte et nombres) et dans le deuxième, nom prénom (mais pas forcément formattés de la même manière que dans le premier fichier) ainsi que d'autres colonnes de texte et de nombres (mais ce sont des données différentes de celles présentes dans le premier fichier).
Voilà, j'espère que j'ai été clair ...
19/05/2006, 08h57
Vesta

ben ca je pense qu'on avait compris... Le nombre de colonnes du fichier 1 et celui du fichier 2. stp.

Ca ne doit etre fait qu'ine fois?
Tu peux mettre les deux feuilles dans un classeur avent de lancer la procédure de jointure? Ce sera plus facile???
19/05/2006, 09h52
ouskel'n'or

As-tu lu mon mp ?
19/05/2006, 16h37
pontus21

Je viens de lire ton MP, ouskel'n'or.
Ca peut m'intéresser. Je te redis.

Citation:

Envoyé par Vesta

ben ca je pense qu'on avait compris... Le nombre de colonnes du fichier 1 et celui du fichier 2. stp.

Ca ne doit etre fait qu'ine fois?
Tu peux mettre les deux feuilles dans un classeur avent de lancer la procédure de jointure? Ce sera plus facile???

8 colonnes dans le fichier 1.
7 colonnes dans le fichier 2.
(dont 'nom', 'prénom' et 'société' dans chaque fichier)

Oui, ça ne doit être fait qu'une fois, puisque je veux passer ces fichiers excel sous forme d'une base de données MySql.

Oui, bien sûr, je peux mettre les 2 feuilles dans le même classeur, un simple "copier-coller" suffit.
Maintenant, je ne sais pas si ce sera plus facile, c'est vous qui me dites. Je suis là pour avoir de l'aide ...
19/05/2006, 16h40
Vesta

Envoie moi les deux feuilles ds un classeur, avec des données a la con mais les bons entetes de colonnes et je te fais un début apres tu l'ameliorera....
19/05/2006, 16h43
pontus21

Ok.
Merci.
Je prépares ça et je t'envoies ...
19/05/2006, 17h16
ouskel'n'or

Pour la routine supprimant les doublons, ce sera lundi, là je ne suis plus au boulot. Mais puisque tu ne vas faire ça qu'une fois, évite d'enlever les accentués, tu vas supprimer tous les accents pour quelques exceptions. Ça ne vaut pas la peine. Si tu fais de la recherche par la suite, que tu mets les accents, tu ne vas rien trouver. Et puis le français est une langue "accentuée" ;)

A+

Barbare mais ca marche...

Code:

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
 
Public Function ReplaceChars(varStringToReplace As String)
  CHAINE_DEPART = "àäâãçéèêëìïîôöòûüùÿÁÀÄÂÃÉÈÊËÍÎÌÔÖÒÓÕÜÛÙÚÝ"
  CHAINE_ARRIVE = "aaaaceeeeiiiooouuyyAAAAAEEEEIIIOOOOOUUUUY"
 
For i = 1 To Len(CHAINE_DEPART)
    varStringToReplace = Replace(varStringToReplace, Mid(CHAINE_DEPART, i, 1), Mid(CHAINE_ARRIVE, i, 1))
Next i
 
ReplaceChars = varStringToReplace
End Function
 
 
Sub AssembleDonnes2()
    Feuil3.Cells.Clear
 
    With Feuil1
        .Columns("A:A").Insert Shift:=xlToRight
 
        .Cells(1, 1) = "Key1"
        For i = 2 To .Range("A1").CurrentRegion.Rows.Count
            .Cells(i, 1) = UCase(ReplaceChars(Replace(Join( _
                   Array(.Cells(i, 3), .Cells(i, 4), .Cells(i, 5))), " ", "")))
        Next i
 
        .Range("A2").CurrentRegion.Sort Key1:=.Range("A2"), Header:= _
            xlGuess
        .Columns("A:I").Copy Feuil3.Range("A1")
 
        .Columns("A:A").Delete Shift:=xlToLeft
    End With
 
    With Feuil2
        .Columns("A:A").Insert Shift:=xlToRight
 
        .Cells(1, 1) = "Key2"
        For i = 2 To .Range("A1").CurrentRegion.Rows.Count
            .Cells(i, 1) = UCase(ReplaceChars(Replace(Join( _
                   Array(.Cells(i, 2), .Cells(i, 3), .Cells(i, 4))), " ", "")))
        Next i
 
        .Range("A2").CurrentRegion.Sort Key1:=.Range("A2"), Header:= _
            xlGuess
        .Columns("A:I").Copy Feuil3.Range("J1")
 
        .Columns("A:A").Delete Shift:=xlToLeft
    End With
End Sub

Seule condition mettre les 2 feuilles dans le meme fichier résultats en feuil3

Voir 40 message(s) de cette discussion en une page