Gestion liste de membres
Le
Jacquouille
Bonjour,
Je reçois tous les mois, une liste des membres en ordre de cotisation.
Forcément, ceux qui ne paient plus, ne sont plus membres.
Tous les mois, certains partent et d'autres arrivent, mais les listes
envoyées mettent tout à la queue leu leu.
Voir exemple;
http://www.cjoint.com/c/EGesQCHY4hI
Est-il possible, via VBA (XL2003 et moi 1948) de faire en sorte que le
tableau ressemble à celui que j'ai mis en explication?
Mille mercis
Bonne fin de WE
Jacques
Jacquouille
" Le vin est au repas ce que le parfum est à la femme."
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
http://www.avast.com
Je reçois tous les mois, une liste des membres en ordre de cotisation.
Forcément, ceux qui ne paient plus, ne sont plus membres.
Tous les mois, certains partent et d'autres arrivent, mais les listes
envoyées mettent tout à la queue leu leu.
Voir exemple;
http://www.cjoint.com/c/EGesQCHY4hI
Est-il possible, via VBA (XL2003 et moi 1948) de faire en sorte que le
tableau ressemble à celui que j'ai mis en explication?
Mille mercis
Bonne fin de WE
Jacques
Jacquouille
" Le vin est au repas ce que le parfum est à la femme."
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
http://www.avast.com
croissant (A..B..C)
Merci
Jacquouille
" Le vin est au repas ce que le parfum est à la femme."
"Jacquouille" a écrit dans le message de groupe de discussion :
mn99gj$tin$
Bonjour,
Je reçois tous les mois, une liste des membres en ordre de cotisation.
Forcément, ceux qui ne paient plus, ne sont plus membres.
Tous les mois, certains partent et d'autres arrivent, mais les listes
envoyées mettent tout à la queue leu leu.
Voir exemple;
http://www.cjoint.com/c/EGesQCHY4hI
Est-il possible, via VBA (XL2003 et moi 1948) de faire en sorte que le
tableau ressemble à celui que j'ai mis en explication?
Mille mercis
Bonne fin de WE
Jacques
Jacquouille
" Le vin est au repas ce que le parfum est à la femme."
---
L'absence de virus dans ce courrier électronique a été vérifiée par le
logiciel antivirus Avast.
http://www.avast.com
---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
http://www.avast.com
1 ere colonne : une liste sans donblon de tous les membres présents
dans le tableau
2 eme colonne : pour le mois de janvier avec "Ok" dans la cellule en
face du nom si celui ci apparait dans la colonne janvier du tableau
reçu et rien s'il n'y est pas
3 eme colonne : pour le mois de fevrier idem
4 eme colonne : mois de mars
...
Jacquouille a exprimé avec précision :
Je te propose ceci :
http://www.cjoint.com/c/EGflWhdsvwn
Essaie (résultat sur Feuil2) :
Sub test()
Dim Tabl1() As String, Tabl2() As Integer, Tabl3() As Integer
Dim Ctr As Integer, Ligne As Variant, Plage As Range, C As Range
Ctr = -1
ReDim Tabl1(0)
ReDim Tabl2(0)
ReDim Tabl3(0)
With Sheets("Feuil1")
Set Plage = .Range("A2", .Cells(.Rows.Count,
1).End(xlUp)).Resize(, 4)
For Each C In Plage
' If C.Value = "nom1" Then Stop
If C.Value <> "" Then
Ligne = Application.Match(C.Value, Tabl1, 0)
If Not IsNumeric(Ligne) Then
Ctr = Ctr + 1
ReDim Preserve Tabl1(Ctr)
ReDim Preserve Tabl2(Ctr)
ReDim Preserve Tabl3(Ctr)
Tabl1(Ctr) = C.Value
Tabl2(Ctr) = 1
Tabl3(Ctr) = C.Column - 1
Else
Tabl2(Ligne - 1) = Tabl2(Ligne - 1) + 1
If C.Column - 1 < Tabl3(Ligne - 1) Then Tabl3(Ligne
- 1) = C.Column - 1
End If
End If
Next C
End With
With Sheets("Feuil2")
.Cells.ClearContents
Sheets("Feuil1").[A1:D1].Copy .[A1]
For i = 0 To UBound(Tabl1)
.Cells(i + 2, 1).Offset(, Tabl3(i)).Resize(,
Tabl2(i)).Value = Tabl1(i)
Next i
End With
End Sub
Daniel
C'était un peu mon idée de départ, mais tous ces X et toutes ces formules,
c'est assez lourd.
Merci pour cette approche.
Jacques
Jacquouille
" Le vin est au repas ce que le parfum est à la femme."
"JLuc69" a écrit dans le message de groupe de discussion :
Une piste sur la façon dont je procederais :
1 ere colonne : une liste sans donblon de tous les membres présents
dans le tableau
2 eme colonne : pour le mois de janvier avec "Ok" dans la cellule en
face du nom si celui ci apparait dans la colonne janvier du tableau
reçu et rien s'il n'y est pas
3 eme colonne : pour le mois de fevrier idem
4 eme colonne : mois de mars
...
Jacquouille a exprimé avec précision :
---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
http://www.avast.com
les membres sont présents, tu aurais pu choisir de faire un X pour
seulement les membres absents.
Pour ce faire, tu n'as qu'à modifier cette ligne de code
If IsNumeric(Application.Match(C, Colonne, 0)) Then
comme ceci :
If Not IsNumeric(Application.Match(C, Colonne, 0)) Then
Il y a seulement le "Not" à ajouter!
Au vu de l'exemple, c'est exactement cela qu'il me faut.
J'ai transposé ton exemple dans mon fichier réel....et j'ai un petit
problème:
Lorsque les colonnes ne sont pas de longueur identique, la macro prend la
dernière ligne en col A.... ce qui amène des désagréments si D ou E ou ...
sont plus longues.
Dans cette ligne, pourrais-tu imaginer un derL non pas d'une colonne, mais
de tout le tableau de datas (dont chaque mois apportera une colonne
supplémentaire)
pour faire bref, il faudrait (du moins, je le pense) un derCol et un derL
sur la colonne la plus longue.
For Each C In .Range("A2:A" & .Range("A65536").End(xlUp).Row)
Ouf.
Déjà merci
Une bonne soirée
Jacques, qui espère avoir beaucoup de nouveaux membres chaque mois.
Jacquouille
" Le vin est au repas ce que le parfum est à la femme."
"MichD" a écrit dans le message de groupe de discussion :
mnb5j7$ilh$
Bonjour,
Je te propose ceci :
http://www.cjoint.com/c/EGflWhdsvwn
---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
http://www.avast.com
'------------------------------------------------------------------------
Sub test()
Dim Col As Object, C As Range, Rg As Range, T()
Dim Cel As Range, Colonne As Range, Sh As Worksheet
Dim Sh2 As Worksheet, DerLig As Long, DerCol As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Set Sh = Worksheets("Feuil1") 'feuille où sont les données
Set Sh2 = Worksheets("Feuil2") 'Feuille Résultat
Set Col = CreateObject("Scripting.Dictionary")
With Sh
DerLig = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
DerCol = Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
With .Range("A1", .Cells(DerLig, DerCol))
Set Rg = .Offset(1).Resize(.Cells.Count - 1)
End With
End With
For Each C In Rg
If Not Col.exists(C.Value) Then
Col.Add C.Value, C.Address
End If
Next
T = Col.keys
With Sh2 'Feuille où sont les résultats.
.Cells.Clear
.Range("B1").Resize(, Rg.Columns.Count).Value = _
Sh.Range("A1").Resize(, Rg.Columns.Count).Value
With .Range("A2").Resize(UBound(T))
.Value = Application.Transpose(T)
.Sort Key1:=.Item(1, 1), order1:=xlAscending, Header:=xlNo
End With
For Each C In .Range("A2:A" & .Range("A65536").End(xlUp).Row)
For Each Colonne In Rg.Columns
If IsNumeric(Application.Match(C, Colonne, 0)) Then
.Cells(C.Row, Colonne.Column + 1) = "X"
End If
Next
Next
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'------------------------------------------------------------------------
DerCol = Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Prière de l'ajouter!
C'est que ça fonctionne, mon cher. Me voici avec une version avec les noms
et une avec les X
grand merci
Bonne soirée
Jacques
Jacquouille
" Le vin est au repas ce que le parfum est à la femme."
"DanielCo" a écrit dans le message de groupe de discussion :
mnb972$qmb$
Bonjour,
Essaie (résultat sur Feuil2) :
Sub test()
Dim Tabl1() As String, Tabl2() As Integer, Tabl3() As Integer
Dim Ctr As Integer, Ligne As Variant, Plage As Range, C As Range
Ctr = -1
ReDim Tabl1(0)
ReDim Tabl2(0)
ReDim Tabl3(0)
With Sheets("Feuil1")
Set Plage = .Range("A2", .Cells(.Rows.Count,
1).End(xlUp)).Resize(, 4)
For Each C In Plage
' If C.Value = "nom1" Then Stop
If C.Value <> "" Then
Ligne = Application.Match(C.Value, Tabl1, 0)
If Not IsNumeric(Ligne) Then
Ctr = Ctr + 1
ReDim Preserve Tabl1(Ctr)
ReDim Preserve Tabl2(Ctr)
ReDim Preserve Tabl3(Ctr)
Tabl1(Ctr) = C.Value
Tabl2(Ctr) = 1
Tabl3(Ctr) = C.Column - 1
Else
Tabl2(Ligne - 1) = Tabl2(Ligne - 1) + 1
If C.Column - 1 < Tabl3(Ligne - 1) Then Tabl3(Ligne
- 1) = C.Column - 1
End If
End If
Next C
End With
With Sheets("Feuil2")
.Cells.ClearContents
Sheets("Feuil1").[A1:D1].Copy .[A1]
For i = 0 To UBound(Tabl1)
.Cells(i + 2, 1).Offset(, Tabl3(i)).Resize(,
Tabl2(i)).Value = Tabl1(i)
Next i
End With
End Sub
Daniel
---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
http://www.avast.com