Ajout des donnees texte

[paul]

Bonsoir a tous,

Voila j'ai une petite question :

Comment faire pour ajouter a la fin d'une ligne les entêtes des colonnes (donnée texte) pour lesquels une cellule est différente de zéro.

Ouf - c'est pour ca que j'ai joint le fichier

merci

 

[Gérard DEZAMIS]

Bonsoir Paul
Une petite solution de bricolo avec les cellules en couleur blanche pour passer incognito !
En plus cela necessite d'occuper une ligne entière (1) !!!
Je suis persuadé que les experts VBA vont te trouver mieux que ça
en attendant
Bonne soirée
@+
Gd

 

[omicron]

Bonsoir Paul,

Si tu programme l'évenement Change de la feuille Feuil1 de la façon qui suit, tu obtiendras le résultat attendu.

=====================================================
Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("A2:L2")) Is Nothing Then
Range("N2").Value = ""
For Each Cel In Range("A2:L2").Cells
If Cel.Value <> 0 Then
If Len(Range("N2").Value) = 0 Then
Range("N2").Value = Cel.Offset(-1, 0).Value
Else
Range("N2").Value = & _
Range("N2").Value & ", " & Cel.Offset(-1, 0).Value
End If
End If
Next Cel
End If

End Sub
=====================================================

Bon courage pour la suite.

Omicron

 

[paul]

Incroyable, C'est INCROYABLE

MERCI les gars, ca marche nickel

 

[paul]

parcontre est il possible de faire la meme chose pour la page A2:N100 ? et surtout comment ?

merci

 

[Monique]

Bonjour,

Autre méthode.

 

[paul]

Merci Monique - je vais regarder ca

bonne nuit

Paul

 

[paul]

Y'a personne qui peut m'aider a faire ma boucle sur une palge donnée ? - dans l'exemple le calcul se fait sur la plage A2:L2 et je voudrais faire le meme calcul mais pour une plage disons A2:L150.

Merci d'avance

===========================================

code :

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("A2:L2")) Is Nothing Then
Range("N2").Value = ""
For Each Cel In Range("A2:L2").Cells
If Cel.Value <> 0 Then
If Len(Range("N2").Value) = 0 Then
Range("N2").Value = Cel.Offset(-1, 0).Value
Else
Range("N2").Value = & _
Range("N2").Value & ", " & Cel.Offset(-1, 0).Value
End If
End If
Next Cel
End If

End Sub

==========================================

 

[paul]

Voila la solution - :

Private Sub Worksheet_Change(ByVal Target As Range)
For i = 2 To 150
Dim varligne As String
Dim cellRes As String
varligne = "C" & i & ":N" & i & ""
cellRes = "R" & i & ""
If Not Intersect(Target, Range(varligne)) Is Nothing Then
Range(cellRes).Value = ""
For Each Cel In Range(varligne).Cells
If Cel.Value <> 0 Then
If Len(Range(cellRes).Value) = 0 Then
Range(cellRes).Value = Cel.Offset(-i + 1, 0).Value
Else
Range(cellRes).Value = Range(cellRes).Value & ", " & Cel.Offset(-i + 1, 0).Value
End If
End If
Next Cel
End If
Next i
End Sub

===============================

autree idee bien venue - merci

 

[omicron]

Bonsoir Paul,

Voici le bout de programme adapté pour répondre au problème posé

=====================================================
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
Set Rng = Range("A2:L100")
If Not Intersect(Target, Rng) Is Nothing Then
For Each Row In Target.Rows
Row.EntireRow.Columns("N").Value = ""
For Each Cel In Row.Columns("A:L").Cells
If Cel.Value <> 0 Then
If Len(Row.EntireRow.Columns("N").Value) = 0 Then
Row.EntireRow.Columns("N").Value = Cel.EntireColumn.Cells(1).Value
Else
Row.EntireRow.Columns("N").Value = Row.EntireRow.Columns("N").Value & _
", " & Cel.EntireColumn.Cells(1).Value
End If
End If
Next Cel
Next Row
End If
End Sub
=====================================================

Si le tableau pré-existe et que tu veux l'actualiser, il faudra en principe resaisir le contenu d'au moins une cellule de chaque ligne afin de déclencher l'évènement Worksheet_Change qui réévalue la cellule N

Pour éviter cette reprise fastidieuse, tu pourras coder et lancer la macro qui suit. Le travail se fera alors automatiquement.

=====================================================
Public Sub Refresh()
For Each Cel In Range("A2:L100").Columns("A")
Cel.Value = Cel.Value
Next Cel
End Sub
=====================================================

Cordialement.

Omicron