Regroupement de données sur une colonne dans un tableau

[Samferrir72]

Bonjour,

Voici mon problème:
J'ai un fichier avec ce format :
Service 1 Service 2 Service 3
client 1 1 2
client 2 2 3
client 3 1 2 3
client 4 1
.....
Si le N° du service est reportée, cela signifie que le client a le service en question

Je souhaiterai avec un fichier avec les données rangées différemment, comme ceci :
Service
Client 1 1
Client 1 2
Client 2 2
Client 2 3
Client 3 1
Client 3 2
Client 3 3
Client 4 1

Est ce possible sous access ou excel ?

Je vous remercie,
Si cela ne passe pas bien, fichier ci joint

Samferrir72

 

[PMO2]

Re : Regroupement de données sur une colonne dans un tableau

Bonjour,

Une piste, dans Excel, avec le code suivant dans lequel les constantes cernées par des ### seront à adapter à votre usage

'### Constantes à adapter ###
Const MA_FEUILLE As String = "test"
Const LIGNE_FIRST_CLIENT As Long = 4
Const NB_COLONNES As Long = 4
'############################

Sub Regroupement()
Dim S As Worksheet
Dim R As Range
Dim var
Dim i&
Dim j&
Dim cpt&
Dim T()
On Error GoTo Erreur
Set S = Sheets(MA_FEUILLE)
S.Activate
Set R = S.Range(Cells(LIGNE_FIRST_CLIENT, 1), Cells(S.[a65536].End(xlUp).Row, NB_COLONNES))
var = R
For i& = 1 To UBound(var, 1)
  For j& = 2 To UBound(var, 2)
    If var(i&, j&) <> "" Then
      cpt& = cpt& + 1
      ReDim Preserve T(1 To 2, 1 To cpt&)
      T(1, cpt&) = var(i&, 1)
      T(2, cpt&) = var(i&, j&)
    End If
  Next j&
Next i&
Set S = Sheets.Add(after:=Sheets(Sheets.Count))
Set R = S.Range(Cells(1, 1), Cells(UBound(T, 2), 2))
R = Application.WorksheetFunction.Transpose(T)
Erreur:
If Err <> 0 Then MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
End Sub

Lancez la macro Regroupement et le résultat s'inscrit dans une nouvelle feuille.

Cordialement.

PMO
Patrick Morange