Boucle pour "enregistrer" un userform

Le 11/08/2011 à 14:11

Bonjour,

Je saite "enregistrer" les valeur(commentaires) saisie dans ma userform. Pour ca je cherche a renvoyer les commentaires dans mon tableau. Il y a cependant une condition, si la condition existe déja dans le tableau, ne pas la recréer, sinon(si elle n'existe pas), je souhaite l'ajouter. Mais après avoir essayer différentes manières, je n'y parviens pas.

Voici mon bout de vba en question :

Sub savecom()
'COMMENTAIRES SAVE +
Dim Lp As Long
Dim Lp1 As Long
Dim II As Byte
Dim JJ As Byte

Worksheets("Feuil1").Select
'lIGNE
For Lp = 9 To Range("B65536").End(xlUp).Row
    For II = 5 To 7
    For JJ = 10 To 12

        If Cells(Lp, "B") Like ComboBox1 Then

        '"Textbox" & I
        Cells(Lp, "C").Value = Me.Controls("TextBox" & II).Value
        Cells(Lp, "D").Value = Me.Controls("TextBox" & JJ).Value
    End If
Next JJ
Next II
Next Lp
End Sub

avec le fichier:

vinny

31vinny.xlsm (22.01 Ko)
Le 11/08/2011 à 14:59

Salut vinny et le forum

Mon transcodeur pour Excel 2003 faisant des siennes, je réponds juste sur le principe.

Ce que je comprends :

  • Tu saisies des données sur un USF. Quand tu valides, tu veux que :
  • Si la Combox1 existe en B => mettre les données à la place en...
  • Si la Combobox1 n'existe pas en B, créer une nouvelle entrée en B

Je sais que tu as donné un fichier d'essais, mais comme je ne peux pas l'ouvrir, je me suis rabattu sur ta macro...

Ma signature est assez explicite

Pour t'aider, il faut qu'on comprenne ce qu'elle est supposée faire, et c'est pas en décodant une macro qui ne fonctionne pas qu'on peut y arriver !

Ta macro :

Quelque soit le B trouvé on applique :

Cells(Lp, "C").Value = Me.Controls("TextBox" & II).Value

Avec II évoluant de 5 à 7. Comme Cells(Lp, "C") n'évolue pas, les 3 infos se retrouvent successivement en C, et donc ta valeur finale en CLp sera TextBox7

Faire une double boucle ne sert qu'à te ralentir : II et JJ étant utilisé indépendamment l'un de l'autre (sans tenir compte des autres erreurs de la macro), je pense que

For X = 5 To 7
    If Cells(Lp, "B") Like ComboBox1 Then
        Cells(Lp, "C").Value = Me.Controls("TextBox" & X).Value
        Cells(Lp, "D").Value = Me.Controls("TextBox" & X + 5).Value
    End If
Next X

Serait plus efficace (à condition que Cells(Lp, C/D) évolue) : un seule boucle, et pas de réinscription.

Pour le reste, n'ayant pas d'exemple, juste des idées :

  • rechercher la valeur de combobox1 dans B (méthode Find)
  • si elle existe renseigner Lp
  • Si elle n'existe pas la créer et renseigner Lp
  • renseigner les colonnes/lignes adéquates par une (seule) boucle.
  • effacer/ré-initialiser l'USF
A+
Le 11/08/2011 à 16:04

Bonjour

A voir

29vinny-userform-v001.xlsm (26.78 Ko)
Le 11/08/2011 à 21:44

bonsoir,

@ Gorfael : Il ne s'agissait que une partie du code, pour le reste :

  • dans mon userform, je sélectionne un nom dans une combobox1, dont les valeurs se situent en B.
  • J'ai 3 cases pour commentaires positifs et 3 cases pour commentaires négatifs, qui se remplisent -> fonctionne bien
  • Je modifie ou non ou ajoute des valeurs dans les textbox (qui affichent les commentaires existants), et souhaite les enregistrer dans le tableau!

@Banzai64 : J'ai changer avec ton code, qui fonctionne partiellement...

En effet, quand je selectionne "A" et modifie les commentaires, cela fonctionne (car il y a déja 3 lignes "A" dans le tableau)

Mais quand je selectionne "B" et modifie les commentaires, seuls les 2 premières lignes se modifient ( car il y a que 2 "B" dans le tableau)

Il faudrait donc une condition supplémentaire qui enregistre en dessous du tableau existant s'il n'y a a pas 3 lignes dans le tableau!?

le code complet avec modification de Banzai64 :

Option Explicit

Dim Init As Boolean

Private Sub ComboBox1_Change()
Dim NomSTCom As String
Dim Com As Range
Dim i As Byte

If Init = True Then Exit Sub

'--- tri ---
'Sheets("Feuil1").Select
'    Range("b9:b" & [b65000].End(xlUp).Row).Sort Key1:=Range("b9"), Order1:=xlAscending, _
'    Header:=xlYes, OrderCustom:=1, MatchCase:=False

  If Me.ComboBox1.ListIndex = -1 Then Exit Sub

  On Error Resume Next                ' Utile car manque les TextBox 8 et 9
  For i = 5 To 12
    Me.Controls("Textbox" & i) = ""
  Next i
  On Error GoTo 0

  NomSTCom = Me.ComboBox1.Value
  With Sheets("Feuil1")
    Set Com = .Columns(2).Find(NomSTCom, LookIn:=xlValues, LookAt:=xlWhole)
    If Not Com Is Nothing Then
      'premier commentaire positif sur le sous traitant selectionnée dans la liste
      TextBox5 = .Cells(Com.Row, "C")
      TextBox10 = .Cells(Com.Row, "D")

      'deuxième commentaire positif sur le sous traitant selectionnée dans la liste
      If .Range("B" & Com.Row).Offset(1, 0) = NomSTCom Then
        TextBox6 = .Cells(Com.Row, "C").Offset(1, 0)
        TextBox11 = .Cells(Com.Row, "D").Offset(1, 0)
      End If

        'troisième commentaire positif sur le sous traitant selectionnée dans la liste
      If .Range("B" & Com.Row).Offset(2, 0) = NomSTCom Then
        TextBox7 = .Cells(Com.Row, "C").Offset(2, 0)
        TextBox12 = .Cells(Com.Row, "D").Offset(2, 0)
      End If
    End If
  End With
End Sub

'ENREGISTREMENT NOTES & COM

Private Sub CommandButton1_Click()
savecom
Unload Me
End Sub

Sub savecom()
'COMMENTAIRES SAVE +
Dim NomSTCom As String
Dim Com As Range

  If Me.ComboBox1.ListIndex = -1 Then Exit Sub

  NomSTCom = Me.ComboBox1.Value
  With Sheets("Feuil1")
    Set Com = .Columns(2).Find(NomSTCom, LookIn:=xlValues, LookAt:=xlWhole)
    If Not Com Is Nothing Then
      'premier commentaire positif sur le sous traitant selectionnée dans la liste
      .Cells(Com.Row, "C") = TextBox5
      .Cells(Com.Row, "D") = TextBox10

      'deuxième commentaire positif sur le sous traitant selectionnée dans la liste
      If .Range("B" & Com.Row).Offset(1, 0) = NomSTCom Then
        .Cells(Com.Row, "C").Offset(1, 0) = TextBox6
        .Cells(Com.Row, "D").Offset(1, 0) = TextBox11
      End If

        'troisième commentaire positif sur le sous traitant selectionnée dans la liste
      If .Range("B" & Com.Row).Offset(2, 0) = NomSTCom Then
        .Cells(Com.Row, "C").Offset(2, 0) = TextBox7
        .Cells(Com.Row, "D").Offset(2, 0) = TextBox12
      End If
    End If
  End With
'Dim Lp As Long
'Dim Lp1 As Long
'Dim II As Byte
'Dim JJ As Byte
'
'Worksheets("Feuil1").Select
''lIGNE
'For Lp = 9 To Range("B65536").End(xlUp).Row
'    For II = 5 To 7
'    For JJ = 10 To 12
'
'        If Cells(Lp, "B") Like ComboBox1 Then
'
'        '"Textbox" & I
'        Cells(Lp, "C").Value = Me.Controls("TextBox" & II).Value
'        Cells(Lp, "D").Value = Me.Controls("TextBox" & JJ).Value
'    End If
'Next JJ
'Next II
'Next Lp
End Sub

'INITIALIZE
'INITIALIZE
'INITIALIZE
'INITIALIZE
'INITIALIZE
Private Sub UserForm_Initialize()
'Macro Dan : liste ST
Dim J As Long

  Init = True
  With Sheets("Feuil1")
    For J = 9 To .Range("B" & Rows.Count).End(xlUp).Row
      Me.ComboBox1 = .Range("B" & J)
      If Me.ComboBox1.ListIndex = -1 Then
        Me.ComboBox1.AddItem .Range("B" & J)                    ' On note sa valeur
      End If
    Next J
  End With
  Me.ComboBox1.ListIndex = -1
  Init = False
End Sub

Vinny

Le 11/08/2011 à 22:10

Bonsoir

Une modification pour rajouter

36vinny-userform-v002.xlsm (26.63 Ko)
Rechercher des sujets similaires à "boucle enregistrer userform"