Fusion + Concatenation intelligente.

Version imprimable

06/06/2011, 17h05
oraclus

1 pièce(s) jointe(s)

Fusion + Concatenation intelligente.

Bonjour à tous,

J'ai pas mal surfé pour essayer de trouver une réponse mais pour l'instant je patauge.

Disons que j'ai deux fichier excel.

Le premier contient en colonne A des nom, en B des dates de naissance.
Le deuxième fichier contient en A des noms (correspondant à celle du premier fichier) en B des pathologies.

Le hic c'est qu'il y a pour une même personne (même noms) plusieurs pathologies... il y a donc plusieurs lignes portant le même nom.

Il faudrait donc que je puisse concatener les pathologies afin qu'elle puisse être injectée dans le premier fichier sous la forme d'une nouvelle colonne.

Évidemment les fichiers dont je parle contiennent plusieurs milliers de lignes.

Je ne vois pas comment utiliser les fonctions de base donc je pense que je vais devoir passer par une maccro pour cela.

Merci d'avance de votre aide.

Bonjour
Par tableau

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Dim LastLig1 As Long, LastLig2 As Long, i As Long, j As Long
Dim Patho As String
Dim T1, T2
 
Application.ScreenUpdating = False
With Sheets("Fichier 2")
    LastLig2 = .Cells(.Rows.Count, "A").End(xlUp).Row
    T2 = .Range("A1:B" & LastLig2).Value
End With
 
With Sheets("Fichier 1")
    LastLig1 = .Cells(.Rows.Count, "A").End(xlUp).Row
    T1 = .Range("A1:C" & LastLig1).Value
    For i = 1 To LastLig1
        For j = 1 To LastLig2
            If Trim(T2(j, 1)) = Trim(T1(i, 1)) Then Patho = Patho & " " & T2(j, 2)
        Next j
        T1(i, 3) = Trim(Patho)
        Patho = vbNullString
    Next i
    .Range("A1:C" & LastLig1).Value = T1
End With

08/06/2011, 10h52
oraclus

Merci cela fonctionne effectivement.

Je n'ai plus qu'à comprendre comment et je ferais les modifs pour l'adapter à mes fichiers.

Bonjour
Ci-joint proposition à adapter (cf. commentaires et éventuellement au niveau des colonnes):
A partir du fichier destination, ouvrir le fichier source, importer les données, fermer le fichier source et réorganiser les données dans le fichier destination.

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
Sub Test()
Dim Wbk As Workbook
Dim LastLig1 As Long, LastLig2 As Long, i As Long, j As Long
Dim Chemin As String, Fichier As String, Patho As String
Dim T1, T2
 
Application.ScreenUpdating = False
Chemin = "C:\Documents and Settings\Administrateur\Bureau\"     'ICI ADAPTER Chemin de ton fichier source
Fichier = "FichierSource.xls"                                   'ICI ADAPTER Nom de ton fichier source
If Dir(Chemin & Fichier) <> "" Then
    Set Wbk = Workbooks.Open(Chemin & Fichier)
    With Wbk.Worksheets("FeuilleSource")                        'ICI ADAPTER FeuilleSource est la feuille du classeur 2 d'où l'import d'informations
        LastLig2 = .Cells(.Rows.Count, "A").End(xlUp).Row
        T2 = .Range("A1:B" & LastLig2).Value
    End With
    Wbk.Close False
    Set Wbk = Nothing
 
    With ThisWorkbook.Worksheets("FeuilleDestination")          'ICI ADAPTER FeuilleDestination est la feuille du classeur 1 où l'import d'informations sera fait
        LastLig1 = .Cells(.Rows.Count, "A").End(xlUp).Row
        T1 = .Range("A1:C" & LastLig1).Value
        For i = 1 To LastLig1
            For j = 1 To LastLig2
                If Trim(T2(j, 1)) = Trim(T1(i, 1)) Then Patho = Patho & " " & T2(j, 2)
            Next j
            T1(i, 3) = Trim(Patho)
            Patho = vbNullString
        Next i
        .Range("A1:C" & LastLig1).Value = T1
        MsgBox "Import données terminé"
    End With
Else
    MsgBox "Fichier " & Chemin & Fichier & " introuvable"
End If
End Sub

08/06/2011, 11h35
oraclus

Bon j'ai réussi à faire les modifications de sorte à ce que ca fonctionne sur mes fichiers.
Le seul problème que je rencontre c'est comment choisir la colonne dans laquelle les données sont rapatriées ?

Par défaut cela semble être C

Merci de votre aide

EDIT : Je n'avais pas vu la précédente réponse je me penche dessus
Edit 2 : Merci pour le compléments ca me permettra de ne pas avoir a copier coller une feuille d'un classeur dans l'autre. Par contre je ne comprends toujours pas comment choisir la colonne dans laquelle les infos sont rapatriées. Si par exemple je souhaite que la colonne utilisée soit EJ ?

Quelqu'un détiendrait il la solution ?

Citation:

Par contre je ne comprends toujours pas comment choisir la colonne dans laquelle les infos sont rapatriées. Si par exemple je souhaite que la colonne utilisée soit EJ ?
17/06/2011, 16h31
gFZT82
Bonjour oraclus

Tu peux remplacer

Code:

.Range("A1:C" & LastLig1).Value = T1

Par
Code:

1 2 3 For k = 1 To LastLig1 .Range("EJ" & k) = T1(k, 3) Next k
Cordialement.