Discussion :

[ftrap]

Bonjour,

Je cherche à modifier la mise en forme de mon tableau de la façon suivante :

Désolé pour la mise en page des tableaux mais je n'arrive pas à faire autrement. (Voir fichier excel sinon)

Tableau initial ( premières lignes)

  A           B          C       
1290	 2,8771	    0,57651
1290	 2,8763	    0,57653
1291	 2,8754	    0,57651
1291	 2,8744	    0,5765
1291	 2,8735	    0,57649
1292	 2,8725	    0,57649
1292	 2,8713	    0,57648
1292	 2,8705	    0,57648

Tableau final

F           G

1290	2
2,8771	0,57651
2,8763	0,57653
1291	3
2,8754	0,57651
2,8744	0,5765
2,8735	0,57649
1292	3
2,8725	0,57649
2,8713	0,57648
2,8705	0,57648

Il faut que je connaisse à chaque fois le nombre de valeurs identiques de la colonne A et que je mette son numéro dans la colonne G. J'aimerais si possible généraliser la formule pour l'étirer à mon tableau entier.

Merci pour votre aide

[casefayere]

Bonjour,
Une proposition tarabiscotée, mais qui devrait fonctionner :

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
Option Explicit
'en admettant que tes données commencent en ligne 2
Sub copiage()
Dim derlg, x
derlg = Range("a" & Rows.Count).End(xlUp).Row
Range("a2:c" & derlg).Copy Range("f2")
For x = derlg To 3 Step -1
  Range("F" & x, "H" & x).Insert Shift:=xlDown
Next
derlg = Range("F" & Rows.Count).End(xlUp).Row
For x = 2 To derlg Step 2
  Range("F" & x + 1, "G" & x + 1) = Range("G" & x, "H" & x).Value
  Range("G" & x, "H" & x).Clear
Next
derlg = Range("F" & Rows.Count).End(xlUp).Row
For x = derlg - 1 To 3 Step -2
  If Range("F" & x) = Range("F" & x - 2) Then
    Range("F" & x, "G" & x).Delete Shift:=xlUp
  End If
Next
End Sub

[ftrap]

Merci pour votre réponse.

Le code fonctionne mais n'affiche pas le nombre de valeurs identiques dans la colonne G.

1290 2
2,8771 0,57651
2,8763 0,57653
1291 3
2,8754 0,57651
2,8744 0,5765
2,8735 0,57649

[casefayere]

ça il fallait le comprendre, d'après ton problème initial, regardes bien ce que tu as soumis

1290 2,8771 0,57651
1290 2,8763 0,57653
1291 2,8754 0,57651
1291 2,8744 0,5765
1291 2,8735 0,57649
1292 2,8725 0,57649
1292 2,8713 0,57648
1292 2,8705 0,57648

Je suis obligé de partir mais y regarderai dès que possible, à moins qu'une bonne âme intervienne entre temps et te donne satisfaction

[ftrap]

Oui ce n'était peut être pas très clair.

Je souhaite arriver à ce tableau-ci :


1290 2
2,8771 0,57651
2,8763 0,57653
1291 3
2,8754 0,57651
2,8744 0,5765
2,8735 0,57649
1292 3
2,8725 0,57649
2,8713 0,57648
2,8705 0,57648


Par exemple, le chiffre 2 correspond au nombre de valeur 1290.

Le plus simple peut être serait de le faire en 2 programmes séparés. Pour l'instant avec votre programme j'arrive au tableau suivant :


1290
2,8771 0,57651
2,8763 0,57653
1291
2,8754 0,57651
2,8744 0,5765
2,8735 0,57649
1292
2,8725 0,57649
2,8713 0,57648
2,8705 0,57648


Merci pour votre aide

[Marc-L]

Bonjour,

pour moi c'était assez clair mais j'ai dû m'interrompre pour la pose déjeuner …

Voici ma version rapide (via des variables tableau) fonctionnant depuis la feuille active, source depuis la cellule A1 et résultat à partir de F1 :

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
Sub Demo()
    If [A1] > "" Then
        L& = [A1].End(xlDown).Row
        TS = Range("A1:C" & L)
        ReDim TF(1 To 2, 1 To L)
 
        For R& = 1 To L
            T& = T& + 1
            If T + 1 > UBound(TF, 2) Then ReDim Preserve TF(1 To 2, 1 To T + 1)
 
            If TS(R, 1) <> V Then
                If P& Then TF(2, P&) = N&
                                   V = TS(R, 1)
                            TF(1, T) = V
                                   N = 0
                                   P = T
                                   T = T + 1
            End If
 
            TF(1, T) = TS(R, 2)
            TF(2, T) = TS(R, 3)
                   N = N + 1
        Next
 
        TF(2, P) = N
        If UBound(TF, 2) > T Then ReDim Preserve TF(1 To 2, 1 To T)
        L = Cells(Rows.Count, 6).End(xlUp).Row
        If L > T Then Cells(T + 1, 6).Resize(L - T, 2).ClearContents
        [F1].Resize(T, 2) = Application.Transpose(TF)
    End If
End Sub

_______________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

[danixdb]

Bonjour ftrap, le Forum,

Voici un petit bout de code qui devrait répondre à ta demande

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
Option Explicit
Option Base 1
 
Sub Test()
  Dim intCpt As Integer, varKey As Variant
  Dim aArray() As Variant, intPos As Integer, i As Integer
 
  Cells(1, 1).Select
  intCpt = 0
  i = 1
  ReDim aArray(500, 2)
  Do While Not IsEmpty(ActiveCell.Value)
    varKey = ActiveCell.Value ' Définit la valeur pour tester si plusieurs valeurs identiques dans la boucle suivante
    aArray(i, 1) = varKey
    intPos = i ' Permet de garder la position dans le tableau pour écrire le nombre d'occurence
    Do While ActiveCell.Value = varKey
      intCpt = intCpt + 1
      aArray(intPos, 2) = intCpt
      aArray(i + 1, 1) = ActiveCell.Offset(0, 1).Value
      aArray(i + 1, 2) = ActiveCell.Offset(0, 2).Value
      ActiveCell.Offset(1, 0).Select
      i = i + 1
    Loop
    i = i + 1
    intCpt = 0
  Loop
 
  Cells(1, 9).Select
  For i = 1 To UBound(aArray)
    If aArray(i, 1) = "" Then Exit For ' Permet de sortir de la boucle si plus de données à écrire
    Cells(ActiveCell.Row, 9) = aArray(i, 1)
    Cells(ActiveCell.Row, 10) = aArray(i, 2)
    ActiveCell.Offset(1, 0).Select
  Next
End Sub

Slts

[ftrap]

Merci beaucoup tout le monde. Problème résolu

[Marc-L]

Merci de cliquer sur pour chaque message ayant aidé ‼ …


De plus comment sait-on quelle solution as-tu adoptée ?


(modification de la ligne n°27 de mon code …)


__________________________________________________
- A ton avis, quel est le plus grand mal de notre époque : l'ignorance ou l'indifférence ?
- J' sais pas et j' m'en fous !