Ajouter des données en concatenation

F

FaruSZ

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

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
 

Pièces jointes

  • Suivi_Presence.xlsm
    34.9 KB · Affichages: 11
Trier par date Trier par votes
Dranreb

Dranreb

XLDnaute Barbatruc
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 …
 
Vote positif 0 Vote négatif
F

FaruSZ

XLDnaute Occasionnel
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 …
Cliquez pour agrandir...
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....
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
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.
 
Vote positif 0 Vote négatif
F

FaruSZ

XLDnaute Occasionnel
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 ?
Cliquez pour agrandir...
Oui c'est exament ca :

aaaaaaaaa.JPG

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
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
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.
 
Dernière édition:
Vote positif 0 Vote négatif
F

FaruSZ

XLDnaute Occasionnel
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.
Cliquez pour agrandir...
Merci enormement ca marche comme je voulais.
PS: le A dans mon illustration est du a une faute de frape.
 
Vote positif 0 Vote négatif
F

FaruSZ

XLDnaute Occasionnel
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.
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
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.
 
Vote positif 0 Vote négatif

Discussions similaires

F
  • Question
XL 2016 Ajouter des donnees l'un apres l'autre
Réponses
1
Affichages
509
Dranreb
Dranreb
C
  • Résolu(e)
XL 2021 Remplir données devis en vba avec descriptions/quantités/PUs alignés
2
Réponses
18
Affichages
1 K
Phil69970
Phil69970
A
  • Question
Microsoft 365 boucle macro pour importer des données
2
Réponses
16
Affichages
2 K
Arnaud Legay
A
Y
  • Résolu(e)
XL 2016 Transfère des données réparties sur des lignes à une base de données
Réponses
12
Affichages
2 K
soan
S
O
  • Résolu(e)
XL 2013 Rajouter par VBA des lignes vides et des sommes dans un tableau
Réponses
12
Affichages
1 K
vgendron
vgendron
S
  • Question
XL 2019 VBA Copier/coller données en fonction de la date
Réponses
2
Affichages
1 K
SimpsonHomer
S
F
  • Question
XL 2016 copier coller une ligne d'une feuille a une 2eme feuille en utilsant un bouton de commande
Réponses
4
Affichages
832
FaruSZ
F
F
  • Question
XL 2016 Ajouter des donnees dans differentes colonnes et mm ligne
Réponses
0
Affichages
612
FaruSZ
F
F
  • Question
Ajouter des données sous condition de positionnement
Réponses
2
Affichages
820
FaruSZ
F
P
  • Résolu(e)
Microsoft 365 Passer des lignes quand une condition est remplie en Macro
Réponses
11
Affichages
1 K
sylvanu
sylvanu

Membres actuellement en ligne

19 membres et 152 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 085
Messages
2 116 071
Membres
112 648
dernier inscrit
Otete Christian