Autres Condition dans listbox

saddoud w

XLDnaute Nouveau
J’ai un problème de condition dans ma listbox …car j’ai fait une première condition puis j’ai voulu ajouter une autre mais je trouve une difficulté …. Je veux fusionner deux valeur en double (Me.ListBox1.List(I, 3)) et avoir la somme de deux ou plusieurs valeurs de (Me.ListBox1.List(I, 4)) en gardent la condition sur la (Me.ListBox1.List(I, 4))
Merci d’avance pour tout aide
 

cp4

XLDnaute Barbatruc
Bonjour,
Merci pour vos remarques et je vais essayer de les appliquer la prochaine fois 😊... S'il vous plaît supprime les fichiers puisqu'il contient des noms de familles... Je m'excuse pour ma manière
Re,
Pour la suppression des fichiers aucun soucis. Comme tu n'avais pas donné d'explication concernant les calculs, j'ai comme je l'avais compris. Donc voici de nouveaux codes pour l'affichage.
Pour le transfert, est-ce que tu cumules les lignes sur la feuille ou tu l'effaces avant le transfert?
VB:
Private Sub CommandButton1_Click()
   Dim Tb, dMat As Object, dNom As Object, i As Integer, j As Integer, dl As Long
   Me.ListBox1.Clear

   Set plage = F.[b4].CurrentRegion
   Set dMat = CreateObject("scripting.dictionary")
   Set dNom = CreateObject("scripting.dictionary")

   Tb = F.Range("A5:Q" & F.Range("A" & Rows.Count).End(xlUp).Row).Value

   For i = 1 To UBound(Tb)
      dMat(Tb(i, 2)) = dMat(Tb(i, 2)) + Tb(i, 16)
      dNom(Tb(i, 3)) = ""
   Next i

   For j = 0 To dMat.Count - 1
      Me.ListBox1.AddItem
      ListBox1.List(ListBox1.ListCount - 1, 0) = j + 1
      ListBox1.List(ListBox1.ListCount - 1, 1) = dMat.keys()(j)
      ListBox1.List(ListBox1.ListCount - 1, 2) = dNom.keys()(j)
      ListBox1.List(ListBox1.ListCount - 1, 3) = FormatNumber(dMat.items()(j), 3)

      'textbox2=limite de remboursement----textbox1=valeur de remboursement
      If ListBox1.List(ListBox1.ListCount - 1, 3) < Val(TextBox2.Value) Then
         ListBox1.List(ListBox1.ListCount - 1, 4) = FormatNumber((dMat.items()(j) / 2), 3)
         ListBox1.List(ListBox1.ListCount - 1, 5) = FormatNumber((dMat.items()(j) / 2), 3)
      Else
         ListBox1.List(ListBox1.ListCount - 1, 4) = FormatNumber((dMat.items()(j) - Val(TextBox1.Value)), 3)
         ListBox1.List(ListBox1.ListCount - 1, 5) = FormatNumber(CSng(TextBox1.Value), 3)
      End If
   Next j

   Call Cumul

End Sub
Private Sub Cumul()
'ici code pour mettre à jour textbox3,4 et 5
   Dim i As Integer
   If Me.ListBox1.ListCount <> 0 Then
      Dim T As Single, T1 As Single, T2 As Single   'déclare la variable T (Total) / Type à adapter
      With ListBox1   'prend en compte la ListBox1 (à adapter)
         For i = 0 To .ListCount - 1   'boucle sur tous les lignes de la ListBox1
            T = T + .Column(3, i)   'définit le total T
            T1 = T1 + .Column(4, i)
            T2 = T2 + .Column(5, i)
         Next i   'prochaine ligne de la boucle
         TextBox3.Value = Format(T, "#,##0.000")   'renvoie dans la TextBox1 le total T (à adapter)
         TextBox4.Value = Format(T1, "#,##0.000")
         TextBox5.Value = Format(T2, "#,##0.000")
      End With   'fin de la prise en compte de la ListBox1
   End If
End Sub
En attendant ta réponse A+

edit: J'ai supprimé les fichiers. Ceux de tes fils c'est à toi de les supprimés.
 

saddoud w

XLDnaute Nouveau
Bonsoir,

J'espère que ça répond à tes attentes. Sur le fichier joint, il n'y a plus de noms.

Bonne soirée.

bonsoir,
merci infiniment pour votre Ficher ça ma trop aider ..... pour ce code:
VB:
Sub tri(a(), gauc, droi, NbCol, colTri)        ' Quick sort
   On Error GoTo errormessage:

   ref = a((gauc + droi) \ 2, colTri)
   g = gauc: d = droi
   Do
      Do While a(g, colTri) < ref: g = g + 1: Loop
      Do While ref < a(d, colTri): d = d - 1: Loop
      If g <= d Then
         For c = 0 To NbCol - 1
            temp = a(g, c): a(g, c) = a(d, c): a(d, c) = temp
         Next
         g = g + 1: d = d - 1
      End If
   Loop While g <= d
   If g < droi Then Call tri(a, g, droi, NbCol, colTri)
   If gauc < d Then Call tri(a, gauc, d, NbCol, colTri)

errormessage:
   If Err.Number = 9 Then
      MsgBox "Pas de Réservations pour Imprimer"
   End If
End Sub


j'ai voulu faire le tri sur les matricules mais j'ai supprimer le tri et j'ai oublier le code explicatif 😄 (code fournie par un ami)
merci encore
 

cp4

XLDnaute Barbatruc
bonsoir,
merci infiniment pour votre Ficher ça ma trop aider ..... pour ce code:
VB:
Sub tri(a(), gauc, droi, NbCol, colTri)        ' Quick sort
   On Error GoTo errormessage:

   ref = a((gauc + droi) \ 2, colTri)
   g = gauc: d = droi
   Do
      Do While a(g, colTri) < ref: g = g + 1: Loop
      Do While ref < a(d, colTri): d = d - 1: Loop
      If g <= d Then
         For c = 0 To NbCol - 1
            temp = a(g, c): a(g, c) = a(d, c): a(d, c) = temp
         Next
         g = g + 1: d = d - 1
      End If
   Loop While g <= d
   If g < droi Then Call tri(a, g, droi, NbCol, colTri)
   If gauc < d Then Call tri(a, gauc, d, NbCol, colTri)

errormessage:
   If Err.Number = 9 Then
      MsgBox "Pas de Réservations pour Imprimer"
   End If
End Sub


j'ai voulu faire le tri sur les matricules mais j'ai supprimer le tri et j'ai oublier le code explicatif 😄 (code fournie par un ami)
merci encore
Re, à mettre au frigo pour un autre projet.

edit: Fichier ici
 
Dernière édition:

Discussions similaires

Réponses
17
Affichages
909
  • Question
XL pour MAC mise en forme
Réponses
2
Affichages
189

Statistiques des forums

Discussions
312 443
Messages
2 088 474
Membres
103 863
dernier inscrit
OUIDDIR