Discussion :

[ThalieCH]

Bonjour à tous,

Je sollicite votre aide afin de pouvoir retraiter un fichier excel pour pouvoir effectuer une base de données exploitable de fiches contacts.

1. A chaque fois que c'est marqué : "Fiche complète", il faudrait pouvoir transposer la fiche contact, pour que toutes les données se mettent en colonne et non en ligne.
Sachant que j'ai plus de 10'000 lignes, je n'ai pas envie de faire le copie transpose manuellement pour chaque personne.
Je me dis qu'il y a peut-être un moyen ou on dit : A chaque ligne "Fiche complète", transpose les lignes jusqu'à la prochaine ligne "Fiche complète"...

2. Sachant que les fiches contacts ne contiennent pas toutes le même nombre de lignes, comment transposer les infos identiques d'une fiche contact à une autre, dans la même colonne ?

Voici en annexe ce que j'ai et ce que j'aimerai.

Merci à tous pour votre aide

[BENNASR]

bonjour et bienvenue
ce qui tu demande est difficile sans VBA ... encore très difficile pour quelqu'un autodidacte en VBA comme moi
mais voila une tentative de réponse :
NB : à tester sur une copie de ton fichier pour munir contre tous risque de perte de données
j'ai supposer que la colonne B est vide et j'ai attribuer un code pour chaque nouvelle fiche
puis avec un dictionnaire j'ai transposer les données
ce qui est difficile est de mettre les données dans les cases correspondantes puisqu'il n y a aucune distinction entre une adresse et/ou une spécialité ... donc j'ai mis chaque ligne dans une colonne en espérant que ça t'aide à avancer
voila le code pour test

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub regroupr()
Application.ScreenUpdating = False
Dim F1 As Worksheet
Dim f2 As Worksheet
Dim plage As Range
Dim C As Range
Set F1 = Sheets("Feuil1")
Set f2 = Sheets("Feuil2")
f2.Cells.ClearContents
Dim i As Long
F1.Columns(2).ClearContents
code = 1
Set d = CreateObject("Scripting.Dictionary")
    '**********************************************************
    Set plage = F1.Range("A2:A" & F1.Range("A" & Rows.Count).End(xlUp).Row)
    For Each C In plage
    On Error Resume Next
    If C.Value Like "Fiche*" And Not F1.Cells(C.Row + 1, 1) Like "Fiche" Then
    F1.Cells(C.Row, 2) = code
    End If
    If F1.Cells(C.Row, 2) <> "" Then code = code + 1
    If F1.Cells(C.Row, 2) = "" Then F1.Cells(C.Row, 2) = F1.Cells(C.Row - 1, 2)
    Next C
  TblBD = F1.Range("A2:B" & F1.Range("B" & Rows.Count).End(xlUp).Row)
          For i = 1 To UBound(TblBD)
          clé = TblBD(i, 2)
         d(clé) = d(clé) & "|" & TblBD(i, 1)
          Next i
 f2.Range("A2").Resize(d.Count) = Application.Transpose(d.items)
  Application.DisplayAlerts = False
  f2.Range("A2").Resize(d.Count).TextToColumns Other:=1, DataType:=xlDelimited, OtherChar:="|"
   f2.Columns("A:A").Delete Shift:=xlToLeft
 
   f2.Select
 
  Application.ScreenUpdating = True
  End Sub

Bonne continuation

[ThalieCH]

Merci beaucoup c'est déjà une très bonne base pour un début !

Il faudrait pouvoir trouver la solution désormais pour mettre les données dans les cases correspondantes ... ca c'est une autre affaire !

[BENNASR]

A toi de nous donner comment distinguer .. Genre si c'est 8 chiffres c'est un numéro de téléphone.. Si existe un @ alors c'est un email
Pensez à un chemin ds ce sens

[ThalieCH]

Bonjour,

Nous avons finalement revu les données que nous avions besoin dans notre BD. J'ai pu retraiter les infos non nécessaires et garder seulement celles dont nous avions besoin et utiliser votre bouton VBA Transpose !
Cela nous a permit d'avoir une belle base de données. Merci encore pour votre aide !