Je vous prie
Guillaume04350 a écrit :En fait sa marche ... je regarde pourquoi sa marche pas
c'est très sibyllin ! alors ça marche, ou ça marche pas ? stp, épargne-moi une réponse de Normand comme : « p't'être ben qu'oui, p't'être ben qu'non » !
dhany
Alors" j'ai compris "
Je met mes O cela transfere bien sur TEST RESUME
Maintenant je rajoute un O en G13 pour Exemple
cela tranfere bien aussi
Maintenant si je met un C en G12 dans le TEST RESUME je perd l'information du 1- Parametre 1 et si je met de nouveau un C en G13 il reste
En fait le plus simple si cela est possible c''est que ou a l'ouverture ou a l'enregistrement la feuille TEST RESUME soit effacer et réecrite suivant ce qui ce trouve sur TEST ?
Je crois aussi qu'il faudrait faire comme cela ; je vais voir si j'arrive à le réaliser (mais je ne peux pas le garantir d'avance).
Ou alors je viens d'y pensez " un bouton " sur la feuille TEST RESUME qui fera l'action ? de toutes les feuilles ?
cette mise en page et nickel ! si c'est possible de conserver ceci,
je rajouterais juste je peux avoir plusieurs feuille (2 sur l'exemple, mais je peux en avoir 7 voir 8 ) a traiter ceci est envisageable ou pas ?
sinon franchement Chapeau deja sa me plait beaucoup
Ci joint,
Bonjour Guillaume,
Je te propose ce fichier Excel :
À l'ouverture du fichier, tu es sur la feuille "TEST RESUME", qui est entièrement vide.
Ctrl r ➯ travail effectué (s'il y a avant d'autres résultats affichés, inutile de les effacer)
Je trouve inutile de mettre cette feuille à jour en dynamique et en continu comme avant, et chaque fois que tu veux consulter le résumé des statistiques de chaque feuille "TEST", tu viens sur cette feuille et tu fais Ctrl r ; éventuellement, on peut aussi ajouter le lancement auto de la même macro simplement en sélectionnant cette feuille (mais je déconseille, car tel que, ça te permet de voir les résultats précédents, qui seraient, sinon, effacés dès la sélection de la feuille).
Je te laisse vérifier sur les 2 autres feuilles "TEST" que les résultats que tu as vus correspondent bien aux données que j'ai saisies ; sur ces feuilles, la mise en majuscule auto de c x o se fait toujours comme avant, mais sans rien faire de plus : aucune mise à jour en feuille "TEST RESUME".
Fais des tests bien complets (avec plusieurs séries de données) avant de me donner ton avis.
Si besoin, n'hésite pas à me demander une adaptation supplémentaire.
(NB : quand j'avais joué au morpion, j'avais complètement oublié qu'y'avait aussi le x !
dhany
Bonjour,
Petite erreur de ma part dans la suppression des valeurs
Voici le code de remplacement :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Fe As Worksheet
Dim Cel As Range
Dim Param As String
Dim Col As Integer
Dim DerLig As Long
Dim Lig As Long
Dim Valeur As String
Dim I As Long
On Error GoTo Fin
If Target.Count > 1 Then Exit Sub
If Target.Column < 4 Or Target.Column > 14 Then Exit Sub
Set Fe = Worksheets("TEST RESUME")
Application.EnableEvents = False
If Target.Value Like "[cxo]" Then Target.Value = UCase(Target.Value)
Select Case Target.Column
Case 7, 10 To 14
If Target.Column = 7 Then Col = 1 Else Col = Target.Column - 8
'construit le paramètre car différent d'une feuille à l'autre (TEST et TEST RESUME)
Param = Col & " - " & Application.Proper(Cells(10, Target.Column).Value)
Set Cel = Fe.Columns("A:A").Find(Param, , xlValues, xlWhole)
Valeur = CStr(Cells(Target.Row, 1).Text) & " "
Select Case Target.Value
'ajout du code...
Case "O"
If Not Cel Is Nothing Then
With Fe
'recherche la première ligne vide de la zone du paramètre en cours...
For I = Cel.Row + 1 To Rows.Count
If .Cells(I, 2).Value = "" Then Exit For
Next I
'puis retranche 1 afin d'être sur la dernière ligne de codes
Lig = I - 1
'pour un retour sur la ligne de dessous si plus de 20 codes dans la ligne...
If UBound(Split(.Cells(Lig, 2).Value, " ")) > 19 Then
'passe à la ligne de dessous
Lig = Lig + 1
'si il y a un paramètre en dessous, insère une ligne afin d'avoir toujours
'une ligne vide entre deux zones de paramètres
If .Cells(Lig + 2, 1).Value <> "" Then
.Cells(Lig + 1, 1).EntireRow.Insert
End If
End If
'ajoute le code aux autres
.Cells(Lig, 2).Value = .Cells(Lig, 2).Value & Valeur
End With
Else
'ici, ajoute le paramètre car il n'exista pas
With Fe
'recherche la dernière ligne non vide sur toute la feuille et descend de deux lignes
If Not DefPlage(Fe) Is Nothing Then DerLig = DefPlage(Fe).Rows.Count + 2 Else DerLig = 2
.Columns("A:A").Font.Size = 10
'force le format texte
.Columns("B:B").NumberFormat = "@"
.Cells(DerLig, 1).Value = Param
.Cells(DerLig + 1, 1).Value = "TEST :"
'inscrit le premier code
.Cells(DerLig + 1, 2).Value = Valeur
End With
End If
'suppression du code...
'avec suppression des lignes en fonction de conditions
Case "C"
For I = Cel.Row + 1 To Rows.Count
If Fe.Cells(I, 2).Value <> "" Then
If InStr(Fe.Cells(I, 2).Value, Trim(Valeur)) <> 0 Then
Fe.Cells(I, 2).Value = Replace(Fe.Cells(I, 2).Value, Valeur, "")
If Fe.Cells(I, 2).Value = "" Then
Fe.Cells(I, 2).EntireRow.Delete
If InStr(Fe.Cells(I - 1, 1).Value, "Parametre") <> 0 Then Fe.Cells(I - 1, 1).EntireRow.Delete
End If
Exit For
End If
Else
Exit For
End If
Next I
End Select
End Select
MiseEnForme Fe
Fin: 'permet de rétablir les événements même si une erreur survient
Application.EnableEvents = True
End SubBonjour Guillaume,
Je te propose ce fichier Excel :
TEST V 3.0.xls
À l'ouverture du fichier, tu es sur la feuille "TEST RESUME", qui est entièrement vide.
Ctrl r ➯ travail effectué (s'il y a avant d'autres résultats affichés, inutile de les effacer)
Je trouve inutile de mettre cette feuille à jour en dynamique et en continu comme avant, et chaque fois que tu veux consulter le résumé des statistiques de chaque feuille "TEST", tu viens sur cette feuille et tu fais Ctrl r ; éventuellement, on peut aussi ajouter le lancement auto de la même macro simplement en sélectionnant cette feuille (mais je déconseille, car tel que, ça te permet de voir les résultats précédents, qui seraient, sinon, effacés dès la sélection de la feuille).
Je te laisse vérifier sur les 2 autres feuilles "TEST" que les résultats que tu as vus correspondent bien aux données que j'ai saisies ; sur ces feuilles, la mise en majuscule auto de c x o se fait toujours comme avant, mais sans rien faire de plus : aucune mise à jour en feuille "TEST RESUME".
Fais des tests bien complets (avec plusieurs séries de données) avant de me donner ton avis.
Si besoin, n'hésite pas à me demander une adaptation supplémentaire.
(NB : quand j'avais joué au morpion, j'avais complètement oublié qu'y'avait aussi le x !
) dhany
Bonjour Dhany,
Super cela fait le travail aussi, j'ai pas tester les limites
Juste la mise en page faudrait que tout reste sur la meme page ? l'exemple de Theze qui passe a la ligne automatiquement
Peut etre la mise en place d'un bouton au lieu de faire un ctrl + r ?
merci
Bonjour,
Petite erreur de ma part dans la suppression des valeurs
Voici le code de remplacement :
Private Sub Worksheet_Change(ByVal Target As Range) Dim Fe As Worksheet Dim Cel As Range Dim Param As String Dim Col As Integer Dim DerLig As Long Dim Lig As Long Dim Valeur As String Dim I As Long On Error GoTo Fin If Target.Count > 1 Then Exit Sub If Target.Column < 4 Or Target.Column > 14 Then Exit Sub Set Fe = Worksheets("TEST RESUME") Application.EnableEvents = False If Target.Value Like "[cxo]" Then Target.Value = UCase(Target.Value) Select Case Target.Column Case 7, 10 To 14 If Target.Column = 7 Then Col = 1 Else Col = Target.Column - 8 'construit le paramètre car différent d'une feuille à l'autre (TEST et TEST RESUME) Param = Col & " - " & Application.Proper(Cells(10, Target.Column).Value) Set Cel = Fe.Columns("A:A").Find(Param, , xlValues, xlWhole) Valeur = CStr(Cells(Target.Row, 1).Text) & " " Select Case Target.Value 'ajout du code... Case "O" If Not Cel Is Nothing Then With Fe 'recherche la première ligne vide de la zone du paramètre en cours... For I = Cel.Row + 1 To Rows.Count If .Cells(I, 2).Value = "" Then Exit For Next I 'puis retranche 1 afin d'être sur la dernière ligne de codes Lig = I - 1 'pour un retour sur la ligne de dessous si plus de 20 codes dans la ligne... If UBound(Split(.Cells(Lig, 2).Value, " ")) > 19 Then 'passe à la ligne de dessous Lig = Lig + 1 'si il y a un paramètre en dessous, insère une ligne afin d'avoir toujours 'une ligne vide entre deux zones de paramètres If .Cells(Lig + 2, 1).Value <> "" Then .Cells(Lig + 1, 1).EntireRow.Insert End If End If 'ajoute le code aux autres .Cells(Lig, 2).Value = .Cells(Lig, 2).Value & Valeur End With Else 'ici, ajoute le paramètre car il n'exista pas With Fe 'recherche la dernière ligne non vide sur toute la feuille et descend de deux lignes If Not DefPlage(Fe) Is Nothing Then DerLig = DefPlage(Fe).Rows.Count + 2 Else DerLig = 2 .Columns("A:A").Font.Size = 10 'force le format texte .Columns("B:B").NumberFormat = "@" .Cells(DerLig, 1).Value = Param .Cells(DerLig + 1, 1).Value = "TEST :" 'inscrit le premier code .Cells(DerLig + 1, 2).Value = Valeur End With End If 'suppression du code... 'avec suppression des lignes en fonction de conditions Case "C" For I = Cel.Row + 1 To Rows.Count If Fe.Cells(I, 2).Value <> "" Then If InStr(Fe.Cells(I, 2).Value, Trim(Valeur)) <> 0 Then Fe.Cells(I, 2).Value = Replace(Fe.Cells(I, 2).Value, Valeur, "") If Fe.Cells(I, 2).Value = "" Then Fe.Cells(I, 2).EntireRow.Delete If InStr(Fe.Cells(I - 1, 1).Value, "Parametre") <> 0 Then Fe.Cells(I - 1, 1).EntireRow.Delete End If Exit For End If Else Exit For End If Next I End Select End Select MiseEnForme Fe Fin: 'permet de rétablir les événements même si une erreur survient Application.EnableEvents = True End Sub
Ok je vais tester merci Theze
Bonjour,
Petite erreur de ma part dans la suppression des valeurs
Voici le code de remplacement :
Private Sub Worksheet_Change(ByVal Target As Range) Dim Fe As Worksheet Dim Cel As Range Dim Param As String Dim Col As Integer Dim DerLig As Long Dim Lig As Long Dim Valeur As String Dim I As Long On Error GoTo Fin If Target.Count > 1 Then Exit Sub If Target.Column < 4 Or Target.Column > 14 Then Exit Sub Set Fe = Worksheets("TEST RESUME") Application.EnableEvents = False If Target.Value Like "[cxo]" Then Target.Value = UCase(Target.Value) Select Case Target.Column Case 7, 10 To 14 If Target.Column = 7 Then Col = 1 Else Col = Target.Column - 8 'construit le paramètre car différent d'une feuille à l'autre (TEST et TEST RESUME) Param = Col & " - " & Application.Proper(Cells(10, Target.Column).Value) Set Cel = Fe.Columns("A:A").Find(Param, , xlValues, xlWhole) Valeur = CStr(Cells(Target.Row, 1).Text) & " " Select Case Target.Value 'ajout du code... Case "O" If Not Cel Is Nothing Then With Fe 'recherche la première ligne vide de la zone du paramètre en cours... For I = Cel.Row + 1 To Rows.Count If .Cells(I, 2).Value = "" Then Exit For Next I 'puis retranche 1 afin d'être sur la dernière ligne de codes Lig = I - 1 'pour un retour sur la ligne de dessous si plus de 20 codes dans la ligne... If UBound(Split(.Cells(Lig, 2).Value, " ")) > 19 Then 'passe à la ligne de dessous Lig = Lig + 1 'si il y a un paramètre en dessous, insère une ligne afin d'avoir toujours 'une ligne vide entre deux zones de paramètres If .Cells(Lig + 2, 1).Value <> "" Then .Cells(Lig + 1, 1).EntireRow.Insert End If End If 'ajoute le code aux autres .Cells(Lig, 2).Value = .Cells(Lig, 2).Value & Valeur End With Else 'ici, ajoute le paramètre car il n'exista pas With Fe 'recherche la dernière ligne non vide sur toute la feuille et descend de deux lignes If Not DefPlage(Fe) Is Nothing Then DerLig = DefPlage(Fe).Rows.Count + 2 Else DerLig = 2 .Columns("A:A").Font.Size = 10 'force le format texte .Columns("B:B").NumberFormat = "@" .Cells(DerLig, 1).Value = Param .Cells(DerLig + 1, 1).Value = "TEST :" 'inscrit le premier code .Cells(DerLig + 1, 2).Value = Valeur End With End If 'suppression du code... 'avec suppression des lignes en fonction de conditions Case "C" For I = Cel.Row + 1 To Rows.Count If Fe.Cells(I, 2).Value <> "" Then If InStr(Fe.Cells(I, 2).Value, Trim(Valeur)) <> 0 Then Fe.Cells(I, 2).Value = Replace(Fe.Cells(I, 2).Value, Valeur, "") If Fe.Cells(I, 2).Value = "" Then Fe.Cells(I, 2).EntireRow.Delete If InStr(Fe.Cells(I - 1, 1).Value, "Parametre") <> 0 Then Fe.Cells(I - 1, 1).EntireRow.Delete End If Exit For End If Else Exit For End If Next I End Select End Select MiseEnForme Fe Fin: 'permet de rétablir les événements même si une erreur survient Application.EnableEvents = True End Sub
Re Bonjour,
Ok comme ça sa marche niquel, a tu vu mes autres questions ? ou je peux te faire un récapitulatif ?
Re,
Je pense que le mieux est que tu récapitules ce que tu veux vraiment, procédure événementielle comme je t'ai donné pour une mise à jour instantanée, un bouton pour mise à jour manuelle, une mise à jour automatique à l'ouverture ou fermeture du classeur, etc...
Dans ton code, je ne sais pas à quoi peut servir la lettre "X" et si elle doit être prise en compte ?
Bonjour Guillaume,
Dans ton message de 08:50, tu as demandé la mise en place d'un bouton : c'est fait (en plus du raccourci Ctrl r ; pas à la place)
Pour la mise en page avec un passage automatique à la ligne, je le ferai si tu m'envoies un fichier contenant beaucoup plus de données (je ne veux pas perdre de temps à les inventer et à les taper !
dhany
Bonjour Guillaume,
Dans ton message de 08:50, tu as demandé la mise en place d'un bouton : c'est fait (en plus du raccourci Ctrl r ; pas à la place)
TEST V 3.1.xls
Pour la mise en page avec un passage automatique à la ligne, je le ferai si tu m'envoies un fichier contenant beaucoup plus de données (je ne veux pas perdre de temps à les inventer et à les taper !
) ; pour que ce soit significatif, il faut qu'il y aie suffisamment de données pour que dans le futur résultat, chaque ligne « TEST : » soit très longue et sur 2 lignes (ou même 3 si tu veux). dhany
Ok super je regarde quand je rentre,. En ce qui concerne les donnees justement c'est imprévisible je ne peux pas savoir à l'avance combien de peux avoir de cellule avec le O qui seront reportées en TEST RESUME
Merci
Re,
Je pense que le mieux est que tu récapitules ce que tu veux vraiment, procédure événementielle comme je t'ai donné pour une mise à jour instantanée, un bouton pour mise à jour manuelle, une mise à jour automatique à l'ouverture ou fermeture du classeur, etc...
Dans ton code, je ne sais pas à quoi peut servir la lettre "X" et si elle doit être prise en compte ?
re bonjour Theze dès que je rentre je m'y met pour faire un récap merci
Oui, mais même si c'est imprévisible, il me faut un fichier significatif pour que sans avoir à rentrer plein de données supplémentaires, j'aie juste à exécuter la macro et à modifier mon code VBA pour ajuster le passage automatique à la ligne !
Dans ton fichier réel, les n° de « Repère plan » sont toujours sur 3 chiffres (pas plus) ? si oui, et en supposant qu'il n'y aie que des O, la question est de savoir combien de n° de 3 chiffres tiennent sur une seule ligne (avant de déborder sur la page suivante) ; si par exemple ça déborde à partir du 21ème siècle n° de 3 chiffres, alors c'est juste avant d'écrire ce n° qu'il faudra écrire le caractère CAR(10) de retour à la ligne (et le tour sera joué !).
Mais comme je t'ai déjà indiqué, j'ai aucune envie d'inventer et taper moi-même des données supplémentaires !
donc dans l'attente d'un fichier plus conséquent et plus significatif !
dhany
Oui, mais même si c'est imprévisible, il me faut un fichier significatif pour que sans avoir à rentrer plein de données supplémentaires, j'aie juste à exécuter la macro et à modifier mon code VBA pour ajuster le passage automatique à la ligne !
Dans ton fichier réel, les n° de « Repère plan » sont toujours sur 3 chiffres (pas plus) ? si oui, et en supposant qu'il n'y aie que des O, la question est de savoir combien de n° de 3 chiffres tiennent sur une seule ligne (avant de déborder sur la page suivante) ; si par exemple ça déborde à partir du 21ème
sièclen° de 3 chiffres, alors c'est juste avant d'écrire ce n° qu'il faudra écrire le caractère CAR(10) de retour à la ligne (et le tour sera joué !).Mais comme je t'ai déjà indiqué, j'ai aucune envie d'inventer et taper moi-même des données supplémentaires !
donc dans l'attente d'un fichier plus conséquent et plus significatif !
dhany
Bonsoir Dhany,
Dans l'onglet test resume j'ai marquer des choses ... j'espere que je reste compréhensible
Re,
Je pense que le mieux est que tu récapitules ce que tu veux vraiment, procédure événementielle comme je t'ai donné pour une mise à jour instantanée, un bouton pour mise à jour manuelle, une mise à jour automatique à l'ouverture ou fermeture du classeur, etc...
Dans ton code, je ne sais pas à quoi peut servir la lettre "X" et si elle doit être prise en compte ?
Re bonsoir Theze,
du coup j'ai fait pareil tout est mrquer dans test resume si tu as des questions ...
merci aussi pour ta patience et ton travail
Bonsoir Guillaume,
Voici la nouvelle version du fichier :
TEST V 4.1.xls
dhany
pour la mise en forme du coup tu penses que c'est faisable ? et si il y a aucun nombre a affiché dans la liste ne pas le faire appaitre ? dsl d'etre chiant ;/ mais pour moi malgres les explication la sa reste du chinois
