OVH Cloud OVH Cloud

Données en colonnes à remettre en lignes ?

13 réponses
Avatar
Roland MOIROUX
bonjour,

Je recherche la solution pour passer de

nom rens heures
toto rc 15
rc 12
ra 2
rb 4
tata rb 100
rb 115
ra 5
tutu ra 124
rb 128

à :

nom rc ra rb
toto 27 2 128
tata 0 5 115
turu 0 124 128

de fàcon automatique : création d'uin tableau sur la même feuille
ave un calcul de somme quand c'est le cas (rc de toto par exemple)

Vos aides me seraient très précieuses

Merci beaucoup

3 réponses

1 2
Avatar
Roland MOIROUX
bonjour et merci

Il y a donc dans ton tableur deux possibilites :

TD
BD ET RESULTAT sur deux feuilles différentes

Ou dois je insérer le code VBA ? est ce comme le premier cas ?
Le bouton go est générer ? A quoi sert il ?

MERCI DE TA PATIENCE

"JB" a écrit dans le message de news:

Solution VBA

On Error Resume Next
'--complete noms
[A1].CurrentRegion.SpecialCells(xlCellTypeBlanks).FormulaR1C1 "=R[-1]C"
Range("A1", [A1].End(xlDown)).Value = Range("A1",
[A1].End(xlDown)).Value
Sheets("result").[A1:M1000].ClearContents
'-- Extrait les noms
Sheets("BD").Range("A1:A1000").AdvancedFilter Action:=xlFilterCopy,
_
CopyToRange:=Sheets("result").Range("A1"), Unique:=True
'---- Extrait les codes
Sheets("result").Columns("M:M").Insert Shift:=xlToRight
Sheets("BD").Range("B1:B1000").AdvancedFilter Action:=xlFilterCopy,
_
CopyToRange:=Sheets("result").Range("M1"), Unique:=True
'--- codes
Sheets("result").Range("M2:M10").Copy
Sheets("result").[B1].PasteSpecial Transpose:=True
For Each c In Range("A2", [A65000].End(xlUp))
y = Application.Match(c, Sheets("result").[A:A], 0)
x = Application.Match(c.Offset(0, 1), Sheets("result").[1:1], 0)
Sheets("result").Cells(y, x) = Sheets("result").Cells(y, x) +
c.Offset(0, 2)
Next c
Sheets("result").Columns("M:M").Delete

http://cjoint.com/?jnxhVsEBXR

JB
On 13 sep, 21:53, JB wrote:
-La macro se met dans un module: Alt+F11 puis insertion/module

-Exemples de TCD:

http://boisgontierjacques.free.fr/fichiers/Tabcrois/Tabcrois.xls

JB

On 13 sep, 20:57, "Roland MOIROUX" wrote:



Oulà jb comment fabique t'on un tel tableau !
"JB" a écrit dans le message de news:

Bonsoir,

Une macro pour complter la colonne A:

On Error Resume Next
[A1].CurrentRegion.SpecialCells(xlCellTypeBlanks).FormulaR1C1 > > "=R[-1]C"
Range("A1", [A1].End(xlDown)).Value = Range("A1",
[A1].End(xlDown)).Value

Un TCD

http://cjoint.com/?jntRIHkkUn

JB

On 13 sep, 18:10, "Roland MOIROUX" wrote:

bonjour,

Je recherche la solution pour passer de

nom rens heures
toto rc 15
rc 12
ra 2
rb 4
tata rb 100
rb 115
ra 5
tutu ra 124
rb 128

à :

nom rc ra rb
toto 27 2 128
tata 0 5 115
turu 0 124 128

de fàcon automatique : création d'uin tableau sur la même feuille
ave un calcul de somme quand c'est le cas (rc de toto par exemple)

Vos aides me seraient très précieuses

Merci beaucoup- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -- Masquer le texte des
messages précédents -


- Afficher le texte des messages précédents -




Avatar
JB
Bonjour,

Le code est dans un module:
Alt+F11 puis Insertion/Module

http://cjoint.com/?josmfOayw5

JB

On 14 sep, 17:41, "Roland MOIROUX" wrote:
bonjour et merci

Il y a donc dans ton tableur deux possibilites :

TD
BD ET RESULTAT sur deux feuilles différentes

Ou dois je insérer le code VBA ? est ce comme le premier cas ?
Le bouton go est générer ? A quoi sert il ?

MERCI DE TA PATIENCE

"JB" a écrit dans le message de news:

Solution VBA

On Error Resume Next
'--complete noms
[A1].CurrentRegion.SpecialCells(xlCellTypeBlanks).FormulaR1C1 =
"=R[-1]C"
Range("A1", [A1].End(xlDown)).Value = Range("A1",
[A1].End(xlDown)).Value
Sheets("result").[A1:M1000].ClearContents
'-- Extrait les noms
Sheets("BD").Range("A1:A1000").AdvancedFilter Action:=xlFilterCopy,
_
CopyToRange:=Sheets("result").Range("A1"), Unique:=True
'---- Extrait les codes
Sheets("result").Columns("M:M").Insert Shift:=xlToRight
Sheets("BD").Range("B1:B1000").AdvancedFilter Action:=xlFilterCopy,
_
CopyToRange:=Sheets("result").Range("M1"), Unique:=True
'--- codes
Sheets("result").Range("M2:M10").Copy
Sheets("result").[B1].PasteSpecial Transpose:=True
For Each c In Range("A2", [A65000].End(xlUp))
y = Application.Match(c, Sheets("result").[A:A], 0)
x = Application.Match(c.Offset(0, 1), Sheets("result").[1:1], 0)
Sheets("result").Cells(y, x) = Sheets("result").Cells(y, x) +
c.Offset(0, 2)
Next c
Sheets("result").Columns("M:M").Delete

http://cjoint.com/?jnxhVsEBXR

JB
On 13 sep, 21:53, JB wrote:



-La macro se met dans un module: Alt+F11 puis insertion/module

-Exemples de TCD:

http://boisgontierjacques.free.fr/fichiers/Tabcrois/Tabcrois.xls

JB

On 13 sep, 20:57, "Roland MOIROUX" wrote:

Oulà jb comment fabique t'on un tel tableau !
"JB" a écrit dans le message de news:

Bonsoir,

Une macro pour complter la colonne A:

On Error Resume Next
[A1].CurrentRegion.SpecialCells(xlCellTypeBlanks).FormulaR1C1 =
"=R[-1]C"
Range("A1", [A1].End(xlDown)).Value = Range("A1",
[A1].End(xlDown)).Value

Un TCD

http://cjoint.com/?jntRIHkkUn

JB

On 13 sep, 18:10, "Roland MOIROUX" wrote:

bonjour,

Je recherche la solution pour passer de

nom rens heures
toto rc 15
rc 12
ra 2
rb 4
tata rb 100
rb 115
ra 5
tutu ra 124
rb 128

à :

nom rc ra rb
toto 27 2 128
tata 0 5 115
turu 0 124 128

de fàcon automatique : création d'uin tableau sur la même feu ille
ave un calcul de somme quand c'est le cas (rc de toto par exemple)

Vos aides me seraient très précieuses

Merci beaucoup- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -- Masquer le texte d es
messages précédents -


- Afficher le texte des messages précédents -- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -





Avatar
Philippe.R
Bonsoir,
Pour insérer le code, ouvrir l'explorateur VBA par 1 clic droit sur l'onglet
de la feuille et coller tout ce qui figure entre "Sub..." et "End Sub" dans
la fenêtre de droite dudit explorateur.
Si les colonnes ne sont pas contigües, il y a lieu d'adapter le code.
--
Avec plaisir
Philippe.R
"Roland MOIROUX" a écrit dans le message de
news:46eaa9b3$0$31758$
bonjour et merci une nouvelle fois

Connent et ou inserer ce code ?

De plus si mes colonnes ( rens, heures) ne sont pas contigus, cela
marchera quant même ?
merci de ta patience


"Philippe.R" <AS_rauphil_chez_wanadoo.fr> a écrit dans le message de news:

Oups,
Le code est à corriger comme suit pour gérer correctement l'ajout de
colonne dans le tableau récapitulatif :

Private Sub Worksheet_Change(ByVal Target As Range)
'MPFE le 13/09/2007
Dim deRligSaisie As Long, DerligTab As Long, laLig As Long, _
deRCol As Integer, laCol As Integer, _
leNom As String
deRligSaisie = Range("b6549").End(xlUp).Row
DerligTab = Range("e3216").End(xlUp).Row
If Not Intersect(Target, Range("a2:a" & deRligSaisie + 1)) _
Is Nothing Then
Cells(DerligTab + 1, 5).Value = Target.Value
DerligTab = DerligTab + 1
ElseIf Not Intersect(Target, Range("b2:b" & deRligSaisie + 1)) _
Is Nothing Then
deRCol = Range("az1").End(xlToLeft).Column
For Each c In Range(Cells(1, 6), Cells(1, deRCol))
If c.Value = Target.Value Then
laCol = c.Column
Exit For
ElseIf Application.IsNA(Application.Match(Target.Value, _
Range(Cells(1, 6), Cells(1, deRCol)), 0)) Then
laCol = deRCol + 1
Cells(1, laCol).Value = Target.Value
End If
Next c
deRligSaisie = Range("b6549").End(xlUp).Row
ElseIf Not Intersect(Target, Range("c1:c" & deRligSaisie + 1)) _
Is Nothing Then
deRCol = Range("az1").End(xlToLeft).Column
For i = Target.Row To 2 Step -1
If Cells(i, 1).Value <> "" Then
leNom = Cells(i, 1).Value
Exit For
End If
Next i
For Each c In Range(Cells(1, 6), Cells(1, deRCol))
If c.Value = Target.Offset(0, -1).Value Then
laCol = c.Column
Exit For
End If
Next c
For Each d In Range("e2:e" & DerligTab)
If d.Value = leNom Then
laLig = d.Row
Exit For
End If
Next d
Cells(laLig, laCol).Value = Cells(laLig, laCol).Value + Target.Value
End If
End Sub

--
Avec plaisir
Philippe.R
"Philippe.R" <AS_rauphil_chez_wanadoo.fr> a écrit dans le message de
news:%
Re,
Supposant les données saisies sur un tableau allant de A1 à Cxxxx
et la récapitulation de E1 à ce qu'il faut
dans la page de code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
'MPFE le 13/09/2007
Dim deRligSaisie As Long, DerligTab As Long, laLig As Long, _
deRCol As Integer, laCol As Integer, _
leNom As String
deRligSaisie = Range("b6549").End(xlUp).Row
DerligTab = Range("e3216").End(xlUp).Row
If Not Intersect(Target, Range("a1:a" & deRligSaisie + 1)) _
Is Nothing Then
Cells(DerligTab + 1, 5).Value = Target.Value
DerligTab = DerligTab + 1
ElseIf Not Intersect(Target, Range("b1:b" & deRligSaisie + 1)) _
Is Nothing Then
deRCol = Range("az1").End(xlToLeft).Column
For Each c In Range(Cells(1, 6), Cells(1, deRCol))
On Error GoTo rrr
If c.Value = Target.Value Then
laCol = c.Column
Exit For
End If
Next c
deRligSaisie = Range("b6549").End(xlUp).Row
ElseIf Not Intersect(Target, Range("c1:c" & deRligSaisie + 1)) _
Is Nothing Then
deRCol = Range("az1").End(xlToLeft).Column
For i = Target.Row To 2 Step -1
If Cells(i, 1).Value <> "" Then
leNom = Cells(i, 1).Value
Exit For
End If
Next i
For Each c In Range(Cells(1, 6), Cells(1, deRCol))
If c.Value = Target.Offset(0, -1).Value Then
laCol = c.Column
Exit For
End If
Next c
For Each d In Range("e2:e" & DerligTab)
If d.Value = leNom Then
laLig = d.Row
Exit For
End If
Next d
Cells(laLig, laCol).Value = Cells(laLig, laCol).Value + Target.Value
End If
Exit Sub
rrr:
laCol = deRCol + 1
Cells(1, laCol).Value = Target.Value
End Sub
devrait convenir, comme dans l'exemple joint :
http://cjoint.com/?jnv7jY8sxN
--
Avec plaisir
Philippe.R
"Roland MOIROUX" a écrit dans le message de
news:46e98644$0$18270$
bpnsoir et merci beaucoup

La liste des noms est elle prédéfinie (et donc limitée) ?
ele peut varier de 10 à 800

la liste des rens est elle aussi prédéfinie (et donc limitée) ?
elle est d'une dizaine de renseignements differents







"Philippe.R" <AS_rauphil_chez_wanadoo.fr> a écrit dans le message de
news:
Bonsoir Roland,
Comment se fait la saisie sur ce tableau ?
La liste des noms est elle prédéfinie (et donc limitée) ?
la liste des rens est elle aussi prédéfinie (et donc limitée) ?
--
Avec plaisir
Philippe.R
"Roland MOIROUX" a écrit dans le message de
news:46e96105$0$26260$
bonjour,

Je recherche la solution pour passer de

nom rens heures
toto rc 15
rc 12
ra 2
rb 4
tata rb 100
rb 115
ra 5
tutu ra 124
rb 128

à :

nom rc ra rb
toto 27 2 128
tata 0 5 115
turu 0 124 128

de fàcon automatique : création d'uin tableau sur la même feuille
ave un calcul de somme quand c'est le cas (rc de toto par exemple)

Vos aides me seraient très précieuses

Merci beaucoup




















1 2