Ajouter des données en concatenation

FaruSZ · 22 Juillet 2020

Bonjour,
J'au un BDD dans laquelle je dois rajouter des tests a une feuille en utilisant un userform.

On choisit le test a partir d'une liste déroulante, par exmeple test A et le nom d'une personnequi va se mettre dans la colonne C ligne 3, si je rajoute un autre test A avec le meme nom de eprsonne ou bien une autre personne, ca doit se rajouter dans la colonneD ligne4 et ainsi de suite.
Si on rajoute un test B pour la 1ere fois celui-ci de=oit se positionner dans la colonne C...
j'ai rédigé ce code mais je sais pas quoi modifier pr que ca fonctionne

Private Sub CommandButton1_Click()

Dim ws_suivi As Worksheet

Set ws_suivi = ActiveWorkbook.Worksheets("Suivi_presence ")
fin_col_test = ws_suivi.Cells(1, 256).End(xlToLeft).Column
Fin_Liste_suivi = ws_suivi.Range("A65530").End(xlUp).Row
ws_suivi.Cells(Fin_Liste_suivi + 1, 1) = Me.ComboBox_Pers.Value
'-------------Ajout-------------
Ligne = Application.Match(Me.ComboBox_Pers.Value, Sheets("Liste_Pers").Range("A:A"), 0)
ws_suivi.Cells(Fin_Liste_suivi + 1, 2) = Sheets("Liste_Pers").Range("B" & Ligne)

For i = 3 To fin_col_test

If ws_suivi.Cells(1, i) = "" Then
If Me.ComboBox_Test.Value = ws_suivi.Cells(1, i).Value Then
ws_suivi.Cells(fin_col_test + 1, i) = Me.ComboBox_Test.Value
Else
ws_suivi.Cells(i, fin_col_test + 1) = Me.ComboBox_Test.Value
End If
End If
Next
End Sub

Dranreb · 22 Juillet 2020

Bonjour.
Dans Feuil1 (Suivi_présence) mettez simplement :

VB:

Private Sub CommandButton1_Click()
   UserForm1.Show
   End Sub

Dans UserForm1 :

Code:

Option Explicit
Private TPers()
Private Sub UserForm_Initialize()
   TPers = Feuil2.[A2].Resize(Feuil2.[A1000000].End(xlUp).Row - 1, 2).Value
   Me.ComboBox_Pers.List = TPers
   Me.ComboBox_Test.List = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
   End Sub
Private Sub CommandButton1_Click()
   Dim LP As Long, LS As Long, CS As Long
   LP = Me.ComboBox_Pers.ListIndex + 1
   If LP = 0 Then Exit Sub
   On Error Resume Next
   LS = WorksheetFunction.Match(TPers(LP, 1), Feuil1.[A:A], 0)
   If Err Then
      LS = Feuil1.[A1000000].End(xlUp).Row + 1
      Feuil1.Cells(LS, 1) = TPers(LP, 1)
      Feuil1.Cells(LS, 2) = TPers(LP, 2)
      End If
   On Error GoTo 0
   CS = Feuil1.Cells(LS, 256).End(xlToLeft).Column + 1
   Feuil1.Cells(LS, CS) = ComboBox_Test.Value
   End Sub
Private Sub CommandButton2_Click()
   Unload Me
   End Sub

Mais je ne suis pas tout à fait sûr que c'est ce que vous vouliez …

FaruSZ · 22 Juillet 2020

Dranreb à dit:

Bonjour.
Dans Feuil1 (Suivi_présence) mettez simplement :

VB:

Private Sub CommandButton1_Click()
   UserForm1.Show
   End Sub

Dans UserForm1 :

Code:

Option Explicit
Private TPers()
Private Sub UserForm_Initialize()
   TPers = Feuil2.[A2].Resize(Feuil2.[A1000000].End(xlUp).Row - 1, 2).Value
   Me.ComboBox_Pers.List = TPers
   Me.ComboBox_Test.List = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
   End Sub
Private Sub CommandButton1_Click()
   Dim LP As Long, LS As Long, CS As Long
   LP = Me.ComboBox_Pers.ListIndex + 1
   If LP = 0 Then Exit Sub
   On Error Resume Next
   LS = WorksheetFunction.Match(TPers(LP, 1), Feuil1.[A:A], 0)
   If Err Then
      LS = Feuil1.[A1000000].End(xlUp).Row + 1
      Feuil1.Cells(LS, 1) = TPers(LP, 1)
      Feuil1.Cells(LS, 2) = TPers(LP, 2)
      End If
   On Error GoTo 0
   CS = Feuil1.Cells(LS, 256).End(xlToLeft).Column + 1
   Feuil1.Cells(LS, CS) = ComboBox_Test.Value
   End Sub
Private Sub CommandButton2_Click()
   Unload Me
   End Sub

Mais je ne suis pas tout à fait sûr que c'est ce que vous vouliez …

Merci pour ta réponse mais ce n'est pas ce que je veux exactement, car avec ton code ca me rajoute les tests dans la colonne B l'un après l'autre, or que moi je veux que lorsque je rajoute un 1er test A je le trouve dans la colonne B, un 2eme test A je le trouve dans la colonne C... si je rajoute un test B pour la 1ere fois je le trouve dans la colonne B, un 2eme test B je le trouve dans la colonne C....

Dranreb · 22 Juillet 2020

Je ne comprends pas, désolé.
Ou alors il faudrait créer une nouvelle ligne avec même personne et service déjà existants pour pouvoir occuper les colonnes voulues, si elles sont téjà prises par d'autres tests ?
Faites un exemple de remplissage souhaité avec diverses répétitions de tests et de personnes.

FaruSZ · 22 Juillet 2020

Dranreb à dit:
Je ne comprends pas, désolé.
Ou alors il faudrait créer une nouvelle ligne avec même personne et service déjà existants pour pouvoir occuper les colonnes voulues, si elles sont téjà prises par d'autres tests ?

Oui c'est exament ca :

Tu vois le D par exemple: a chaque fois je rajoute une nvelle personne avec le service et le test il faut que il se rajoute dans la colonne n+1 par rapport a la valeur ancienne ( si i l ya un test D qui est deja dans la colonne 2 par ex) le nouveau doit se positionner dans la colonne 3

Dranreb · 22 Juillet 2020

Essayez comme ça alors :

VB:

Option Explicit
Private TPers(), TPlaces() As Byte
Private Sub UserForm_Initialize()
   TPers = Feuil2.[A2].Resize(Feuil2.[A1000000].End(xlUp).Row - 1, 2).Value
   Me.ComboBox_Pers.List = TPers
   Me.ComboBox_Test.List = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
   ReDim TPlaces(0 To ComboBox_Test.ListCount - 1)
   End Sub
Private Sub CommandButton1_Click()
   Dim LP As Long, LS As Long, CS As Long
   LP = ComboBox_Pers.ListIndex + 1
   If LP = 0 Then Exit Sub
   If Not ComboBox_Test.MatchFound Then Exit Sub
   CS = TPlaces(ComboBox_Test.ListIndex) + 1: If CS < 3 Then CS = 3
   TPlaces(ComboBox_Test.ListIndex) = CS
   On Error Resume Next
   LS = WorksheetFunction.Match(TPers(LP, 1), Feuil1.[A:A], 0)
   If Err Then LS = 0
   On Error GoTo 0
   If LS > 0 Then If Not IsEmpty(Feuil1.Cells(LS, CS).Value) Then LS = 0
   If LS = 0 Then
      LS = Feuil1.[A1000000].End(xlUp).Row + 1
      Feuil1.Cells(LS, 1) = TPers(LP, 1)
      Feuil1.Cells(LS, 2) = TPers(LP, 2)
      End If
   Feuil1.Cells(LS, CS) = ComboBox_Test.Value
   End Sub
Private Sub CommandButton2_Click()
   Unload Me
   End Sub

Notez que dans votre illustration je ne comprend pas le "A" en "Test3" alors qu'il n'apparaît que pour la seconde fois.

FaruSZ · 22 Juillet 2020

Dranreb à dit:

Essayez comme ça alors :

VB:

Option Explicit
Private TPers(), TPlaces() As Byte
Private Sub UserForm_Initialize()
   TPers = Feuil2.[A2].Resize(Feuil2.[A1000000].End(xlUp).Row - 1, 2).Value
   Me.ComboBox_Pers.List = TPers
   Me.ComboBox_Test.List = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
   ReDim TPlaces(0 To ComboBox_Test.ListCount - 1)
   End Sub
Private Sub CommandButton1_Click()
   Dim LP As Long, LS As Long, CS As Long
   LP = ComboBox_Pers.ListIndex + 1
   If LP = 0 Then Exit Sub
   If Not ComboBox_Test.MatchFound Then Exit Sub
   CS = TPlaces(ComboBox_Test.ListIndex) + 1: If CS < 3 Then CS = 3
   TPlaces(ComboBox_Test.ListIndex) = CS
   On Error Resume Next
   LS = WorksheetFunction.Match(TPers(LP, 1), Feuil1.[A:A], 0)
   If Err Then LS = 0
   On Error GoTo 0
   If LS > 0 Then If Not IsEmpty(Feuil1.Cells(LS, CS).Value) Then LS = 0
   If LS = 0 Then
      LS = Feuil1.[A1000000].End(xlUp).Row + 1
      Feuil1.Cells(LS, 1) = TPers(LP, 1)
      Feuil1.Cells(LS, 2) = TPers(LP, 2)
      End If
   Feuil1.Cells(LS, CS) = ComboBox_Test.Value
   End Sub
Private Sub CommandButton2_Click()
   Unload Me
   End Sub

Notez que dans votre illustration je ne comprend pas le "A" en "Test3" alors qu'il n'apparaît que pour la seconde fois.

Merci enormement ca marche comme je voulais.
PS: le A dans mon illustration est du a une faute de frape.

FaruSZ · 23 Juillet 2020

Dranreb à dit:

Essayez comme ça alors :

VB:

Option Explicit
Private TPers(), TPlaces() As Byte
Private Sub UserForm_Initialize()
   TPers = Feuil2.[A2].Resize(Feuil2.[A1000000].End(xlUp).Row - 1, 2).Value
   Me.ComboBox_Pers.List = TPers
   Me.ComboBox_Test.List = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
   ReDim TPlaces(0 To ComboBox_Test.ListCount - 1)
   End Sub
Private Sub CommandButton1_Click()
   Dim LP As Long, LS As Long, CS As Long
   LP = ComboBox_Pers.ListIndex + 1
   If LP = 0 Then Exit Sub
   If Not ComboBox_Test.MatchFound Then Exit Sub
   CS = TPlaces(ComboBox_Test.ListIndex) + 1: If CS < 3 Then CS = 3
   TPlaces(ComboBox_Test.ListIndex) = CS
   On Error Resume Next
   LS = WorksheetFunction.Match(TPers(LP, 1), Feuil1.[A:A], 0)
   If Err Then LS = 0
   On Error GoTo 0
   If LS > 0 Then If Not IsEmpty(Feuil1.Cells(LS, CS).Value) Then LS = 0
   If LS = 0 Then
      LS = Feuil1.[A1000000].End(xlUp).Row + 1
      Feuil1.Cells(LS, 1) = TPers(LP, 1)
      Feuil1.Cells(LS, 2) = TPers(LP, 2)
      End If
   Feuil1.Cells(LS, CS) = ComboBox_Test.Value
   End Sub
Private Sub CommandButton2_Click()
   Unload Me
   End Sub

Notez que dans votre illustration je ne comprend pas le "A" en "Test3" alors qu'il n'apparaît que pour la seconde fois.

bONJOUR,
Pourriez vous m'expliquer le role de ces 2 lignes :
ReDim TPlaces(0 To ComboBox_Test.ListCount - 1)
CS = TPlaces(ComboBox_Test.ListIndex) + 1: If CS < 3 Then CS = 3
Merci

Dranreb · 23 Juillet 2020

Bonjour.
La première attribue même base et dimension que la liste de la ComboBox à ce tableau dynamique destiné à stocker la dernière colonne utilisée pour chaque Test, la seconde l'utilise pour fixer la colonne de sortie pour le Test choisi.
Les propriétés ListCount et ListIndex d'une ComboBox doivent pouvoir se trouver dans l'aide.

Ajouter des données en concatenation

FaruSZ

XLDnaute Occasionnel

Pièces jointes

Dranreb

XLDnaute Barbatruc

FaruSZ

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

FaruSZ

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

FaruSZ

XLDnaute Occasionnel

FaruSZ

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

Discussions similaires