rangement alphabetique d'un rajout avec une boucle

[n3Twork]

Bonjour partant du code de BDDfournisseursV31 je voudrai savoir si c possible de ranger chaque nouvel ajout de maniere alphabetique ?

Private Sub CommandButton4_Click()
Dim AjoutDansGroupe As Object
Dim NV As String
Dim ZT As Integer
Dim ZU As Integer
On Error GoTo fin

If UserForm8.ListBox2.Value = '' Then
MsgBox 'Un groupe de diffusion et une adresse email doivent etre sélectionnés . '
Exit Sub

Else
NV = UserForm8.nouvelleVal.Value
With Sheets('données').Rows(1)
Set AjoutDansGroupe = .Find(UserForm8.ListBox2, LookIn:=xlValues)
ZT = AjoutDansGroupe.Column
ZU = Sheets('données').Cells(1, ZT).End(xlDown).Row + 1
  
Sheets('données').Cells(ZU, ZT) = NV
UserForm8.ListBox3.AddItem (NV)
End With
End If
Exit Sub

fin:
If Err = 6 Then
ZU = 2
Resume Next
End If

Groupe = ''

End Sub

 

[Blunet]

Re:rangement alphabetique d'un rajout avec une bou

re,
avant l'ajout dans la liste tu peux utiliser
Sheets('données').Range(cells(1,1),cells(zu,zt)).sort key:=xlDescending, orientation:=xlSortRows
Tri en ordre Décroissant suivant les lignes, j'ai pas vérifié où débute ta plage à trier !

Ciao

 

[n3Twork]

Re:rangement alphabetique d'un rajout avec une bou

Slt

merci de ta reponse

mais sa ne marche pas, sa ajoute bien la valeur mais en aucun cas sa range ....

 

[MichelXld]

Re:rangement alphabetique d'un rajout avec une bou

bonsoir


tu peux tester cette adaptation


Private Sub CommandButton4_Click()
Dim AjoutDansGroupe As Object
Dim NewMail As String
Dim ZT As Integer, ZU As Integer
Dim Tableau() As String
Dim Valeur As Integer, i As Integer
Dim Cible As Variant

On Error GoTo Fin

If UserForm8.ListBox2.Value = '' Then
MsgBox 'Un groupe de diffusion et une adresse email doivent etre sélectionnés . '
Exit Sub

Else
NewMail = UserForm8.ListBox1
With Sheets('feuil5').Rows(1)
Set AjoutDansGroupe = .Find(UserForm8.ListBox2, LookIn:=xlValues)
ZT = AjoutDansGroupe.Column
ZU = Sheets('feuil5').Cells(65536, ZT).End(xlUp).Row

If ZU = 1 Then
UserForm8.ListBox3.AddItem NewMail
Sheets('feuil5').Cells(2, ZT) = NewMail
Exit Sub
End If

'recuperation données existante dans la liste de diffusion
For i = 0 To ZU - 2
ReDim Preserve Tableau(i + 1)
Tableau(i) = Sheets('feuil5').Cells(i + 2, ZT).Value
Next i

ReDim Preserve Tableau(i) 'ajout nouvelle donnée
Tableau(i) = NewMail

Do 'boucle pour trier le tableau
Valeur = 0
For i = 0 To UBound(Tableau) - 1
If Tableau(i) < Tableau(i + 1) Then
Cible = Tableau(i)
Tableau(i) = Tableau(i + 1)
Tableau(i + 1) = Cible
Valeur = 1
End If
Next i
Loop While Valeur = 1


UserForm8.ListBox3.Clear

For i = UBound(Tableau) To 0 Step -1 'alimentation après tri
UserForm8.ListBox3.AddItem Tableau(i)
Sheets('feuil5').Cells(UBound(Tableau) - i + 2, ZT) = Tableau(i)
Next i

End With
End If

Exit Sub
Fin:
If Err = 6 Then
ZU = 2
Resume Next
End If

Groupe = ''

End Sub



bonne soirée
MichelXld

 

[n3Twork]

Re:rangement alphabetique d'un rajout avec une bou

Bonsoir merci de ta réponse

Jai esayer de l'adpater mais sa ne marche pas ...

 

[MichelXld]

Re:rangement alphabetique d'un rajout avec une bou

bonsoir

adapter quoi ?
cela fonctionne chez moi : j'ai utilisé directement le classeur BDD_Fournisseur pour les tester modifications ...


bonne soirée
MichelXld

Message édité par: michelxld, à: 22/06/2006 22:34

 

[n3Twork]

Re:rangement alphabetique d'un rajout avec une bou

Slt encore merci de ta reponse

je t'envoi le fichier sa sera plus simple 🙂

http://cjoint.com/?gwwKLTNaZK

 

[MichelXld]

Re:rangement alphabetique d'un rajout avec une bou

bonjour

effectivement si tu fais juste un copier/coller sans adapter les noms d'objets à ton classeur , ça ne risque pas de fonctionner

Private Sub CommandButton4_Click()
Dim AjoutDansGroupe As Object
Dim NewMail As String
Dim ZT As Integer, ZU As Integer
Dim Tableau() As String
Dim Valeur As Integer, i As Integer
Dim Cible As Variant

On Error GoTo Fin

If UserForm8.ListBox2.Value = '' Then
MsgBox 'Un groupe de diffusion et une adresse email doivent etre sélectionnés . '
Exit Sub

Else
NewMail = nouvelleVal
With Sheets('Données').Rows(1)
Set AjoutDansGroupe = .Find(UserForm8.ListBox2, LookIn:=xlValues)
ZT = AjoutDansGroupe.Column
ZU = Sheets('Données').Cells(65536, ZT).End(xlUp).Row

If ZU = 1 Then
UserForm8.ListBox3.AddItem NewMail
Sheets('Données').Cells(2, ZT) = NewMail
Exit Sub
End If

'recuperation données existante dans la liste de diffusion
For i = 0 To ZU - 2
ReDim Preserve Tableau(i + 1)
Tableau(i) = Sheets('Données').Cells(i + 2, ZT).Value
Next i

ReDim Preserve Tableau(i) 'ajout nouvelle donnée
Tableau(i) = NewMail

Do 'boucle pour trier le tableau
Valeur = 0
For i = 0 To UBound(Tableau) - 1
If Tableau(i) < Tableau(i + 1) Then
Cible = Tableau(i)
Tableau(i) = Tableau(i + 1)
Tableau(i + 1) = Cible
Valeur = 1
End If
Next i
Loop While Valeur = 1


UserForm8.ListBox3.Clear

For i = UBound(Tableau) To 0 Step -1 'alimentation après tri
UserForm8.ListBox3.AddItem Tableau(i)
Sheets('Données').Cells(UBound(Tableau) - i + 2, ZT) = Tableau(i)
Next i

End With
End If

Exit Sub
Fin:
If Err = 6 Then
ZU = 2
Resume Next
End If

Groupe = ''

End Sub



bonne journée
MichelXld

 

[n3Twork]

Re:rangement alphabetique d'un rajout avec une bou

Merci ca marche impeccable

je rajouterai

Option Compare Text

afin que sa ne fasse pas de difference entre les majuscules et les minuscules pour le rangement ...