Discussion :

[ronankerbi]

Bonjour à tous,

je suis nouveau sur ce forum et je rencontre un problème sur Excel. En effet, j'ai téléchargé une base de données sur le site de l'INSEE qui donnent des informations sur les établissements par commune et si deux observations sont identiques elles sont regroupées avec une colonne fréquence. J'aurais besoin de répéter les lignes en fonction de cette fréquence. Par exemple :
REGION /DEP /APE /Freq
11 12 1103Z 2
12 14 2451Z 4
13 28 1392Z 1
et je souhaiterais obtenir
REGION DEP APE
11 12 1103Z
11 12 1103Z
11 12 1103Z
12 14 2451Z
12 14 2451Z
12 14 2451Z
12 14 2451Z
12 14 2451Z
13 28 1392Z

Je vous remercie par avance de vos réponses.

Ronan

[EngueEngue]

Si j'ai bien compris:

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
Sub toto()
Dim i As Long, j As Long, k As Long
k = 2
With Sheets("Feuil1") 'change le nom de tes feuilles
For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
nombre = .Range("D" & i)
For j = 1 To nombre
Sheets("Feuil2").Cells(k, 1) = .Cells(i, 1)
Sheets("Feuil2").Cells(k, 2) = .Cells(i, 2)
Sheets("Feuil2").Cells(k, 3) = .Cells(i, 3)
k = k + 1
Next j
Next i
End With
End Sub

Cependant il y a 3 fois la première ligne alors qu'il n'y a que 2 en frequence..
De même pour la deuxieme.. 5 vs 4

[ronankerbi]

Je vous remercie pour votre réponse rapide.
C'est une erreur de ma part quand j'ai recopié mes lignes pour faire mon exemple. Effectivement quand la fréquence est de 2, l'enregistrement doit apparaitre 2 fois.

Je vais tester la macro et je vous tiens au courant.

Merci

[ronankerbi]

Je ne comprends pas trop le fonctionnement de la macro. j'ai également oublié de spécifier que j'avais plus de 23 000 lignes que doivent être répété. Est ce que votre macro est adaptable à ma situation?

[EngueEngue]

Elle s'adapte toute seule. Il faut juste changer le nom de tes feuilles...

Feuil1 = Le nom de la feuille ou est le tableau
Feuil2 le nom de la feuille ou va etre ecrit le nouveau tableau

[ronankerbi]

Merci

Par contre mon fichier dispose de 17 colonnes au total, si j'ai bien compris je dois répéter la ligne de code Sheets("Feuil2").Cells(k, 1) = .Cells(i, 1) autant de fois tout en faisant évoluer le nombre?

[EngueEngue]

Tout à fait.. Cells(ligne,colonne)

Par contre si ta frequence n'est pas en colonne D il faut changer ça aussi

[ronankerbi]

ça marche parfaitement. Je vous remercie pour la rapidité de votre réponse et sa précision.

Merci

[vinc_bilb]

Comme ceci si ça peut aider, en supposant que les data's sont dans la sheet "Document". Le tableau n'est pas nécessaire, mais peut aider si des traitements sont requis

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
38
39
40
41
42
43
44
45
46
47
48
 
Sub Extract_data()
 
Dim InpRng As Range
Dim Subname As String
Dim FlatData() As Variant
Dim Rown As Long, RowTab As Long, TabInd As Long, Coln As Long
 
    'Init
Subname = "Extract_data"
On Error GoTo Err_Extract
 
    ' Set the Input range, exit if no data (assuming tittle row)
Set InpRng = Worksheets("Document").Range("A1").CurrentRegion
Debug.Print InpRng.Address
 
If InpRng.Rows.Count < 2 Then
    MsgBox "No data to proceed in sheet " & InpRng.Worksheet.Name, vbExclamation, "ERROR: " & Subname
End If
    ' Redim the array according to the Input data's
ReDim FlatData(1 To 5, 1 To Worksheets("Document").Range("F1").Value)   'Sum of all the /Freq fields
 
    ' Parse the input range, store the result in an array then repeat the values
TabInd = 0
 
For Rown = 2 To InpRng.Rows.Count   'Assuming the records are continuous and the column 4 is with integer
 
 
    For RowTab = 1 To InpRng(Rown, 4)
 
        TabInd = TabInd + 1
 
        For Coln = 1 To 4
            FlatData(Coln, TabInd) = InpRng(Rown, Coln) 'Not really needed, if a specific calculation is needed
            Worksheets("Result").Cells(TabInd, Coln) = InpRng(Rown, Coln).Value
        Next Coln
 
    Next RowTab
 
Next Rown
 
Err_Extract:
    If Err.Number <> 0 Then
        MsgBox Err.Number & vbTab & Err.Description, vbCritical, "ERROR: " & Subname
        Err.Clear
        Exit Sub
    End If
End Sub

[ronankerbi]

Merci Vinc_bilb pour votre réponse le problème a été résolu.