Concaténer cellule en VBA avec conditions

sadness78

XLDnaute Junior
Bonjour le forum,

J'aimerais concaténer une dizaine de cellules en VBA en rajoutant une condition si la cellule est vide il ne met pas de double tiret.

Code:
Option Explicit
Sub test()

Dim liste As String
Dim a As String
Dim b As String
Dim c As String
Dim d As String
Dim e As String
Dim f As String
Dim g As String
Dim h As String
Dim i As String
Dim j As String
Dim k As String

a = Sheets("Launcher").Range("F8").Value
b = Sheets("Launcher").Range("F9").Value
c = Sheets("Launcher").Range("F10").Value
d = Sheets("Launcher").Range("F11").Value
e = Sheets("Launcher").Range("F12").Value
f = Sheets("Launcher").Range("F13").Value
g = Sheets("Launcher").Range("F14").Value
h = Sheets("Launcher").Range("F15").Value
i = Sheets("Launcher").Range("F16").Value
j = Sheets("Launcher").Range("F17").Value
k = Sheets("Launcher").Range("F18").Value


liste = a & "-" & b & "-" & c & "-" & d & "-" & e & "-" & f & "-" & g & "-" & h & "-" & i & "-" & j & "-" & k

Sheets("Attest_BDD").Range("H2:H100") = liste

End Sub

Merci d'avance de vos lumières.

Cdlt,

Sadness
 

Grand Chaman Excel

XLDnaute Impliqué
Re : Concaténer cellule en VBA avec conditions

Bonjour,

Autres questions, afin de clarifier un peu plus :
- Est-ce que les données de l'onglet "Listes des sites" vont changer souvent? Quand seront-elles copiées vers "Attest_BDD" ?
- Peux-t-il y avoir des doublons dans les données? Si oui, lors de la copie vers "Attest_BDD" il faudra vérifier de ne pas avoir 2x les mêmes données?
- D'où proviennent les données de l'onglet "Launcher"? Est-ce l'utilisateur qui les rentre et la macro doit ensuite aller recopier sur la bonne ligne dans l'onglet "Attest_BDD"? ou bien les données doivent être récupérées ailleurs (comme par exemple dans des fichiers dans un répertoire?)

Merci.
 

sadness78

XLDnaute Junior
Re : Concaténer cellule en VBA avec conditions

Bonjour,

Encore fois désolé de ne pas avoir été clair Grand Chaman :

- Ils changeront en permanence les utilisateurs rempliront les informations à la main
- Je dirais Non en temps normal mais si un doublon existe la macro s'arrêtera ?
- C'est exact, l'utilisateur rentrera les informations pour ensuite lancer la macro avec le bouton traitement des données qui recopiera purement et simplement sur les lignes remplies.

Encore merci
 

Grand Chaman Excel

XLDnaute Impliqué
Re : Concaténer cellule en VBA avec conditions

Bonjour,

Voir fichier joint si ça peut t'aider.
Les macros sont dans le module 3.
La 1re copie les nouveaux sites dans l'onglet BDD.
La 2e copie les informations de Launcher vers BDD. L'utilisateur doit entrer un nom de site existant.
J'ai aussi modifié tes formules sous le nom de site par un RECHERCHEV.

VB:
Sub Copie_Sites_vers_BDD()
' Copie les sites vers l'onglet "Attest_BDD"
' Regarde uniquement le nom du site de la colonne A. Si le nom n'existe pas dans Attest_BDD
' alors les informations sont copiées. Donc aucune doublons autorisé.
' La macro s'arrête dès qu'elle rencontre une ligne vide dans la colonne A

    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rg As Range, rg2 As Range
    
    Set ws1 = ThisWorkbook.Sheets("Listes des sites")
    Set ws2 = ThisWorkbook.Sheets("Attest_BDD")
    
    Set rg = ws1.Range("A2")
    Do Until IsEmpty(rg)        'il ne doit y avoir aucune ligne vide dans la colonne A de "Liste des sites"
        Set rg2 = ws2.Range("A2:A60000").Find(rg, LookIn:=xlValues)
        If rg2 Is Nothing Then
            'Copie dans la dernière ligne vide
            rg.Resize(1, 4).Copy ws2.Range("A65000").End(xlUp).Offset(1, 0)
        End If
        Set rg = rg.Offset(1, 0) 'prochaine ligne
    Loop
End Sub


Sub Copie_Launcher_vers_BDD()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rg As Range
    
    Set ws1 = ThisWorkbook.Sheets("Launcher")
    Set ws2 = ThisWorkbook.Sheets("Attest_BDD")
    
    Set rg = ws2.Range("A2:A60000").Find(ws1.Range("E3"), LookIn:=xlValues)
    If Not rg Is Nothing Then   'si le site existe dans BDD
        rg.Offset(0, 8) = ws1.Range("K3")   'date d'effet
        rg.Offset(0, 9) = ws1.Range("K8")   'date d'expiration
        rg.Offset(0, 11) = ws1.Range("E8")  'CDC
    Else
        MsgBox "Site non trouvé"
    End If
End Sub


À essayer...
A+
 

sadness78

XLDnaute Junior
Re : Concaténer cellule en VBA avec conditions

Bonjour Grand Chaman, le forum

Je m’excuse pour le délais de ma réponse.

Merci pour ce code, pour l'instant ça ne marche pas mais j'aimerais bien avoir le fichier joint de ton message comme ca je pourrais essayer de comprendre ce qui ne va pas.

Merci d'avance.

Cdlt,

Sadness
 

sadness78

XLDnaute Junior
Re : Concaténer cellule en VBA avec conditions

Re-Bonjour grand Chaman, le forum,

Alors après plusieurs tests je reviens avec beaucoup plus de précisions :

- La macro Copie_Sites_vers_BDD marche très bien

- La macro Copie Launcher_vers_BDD marche très bien aussi mais celle-ci ne répond pas exactement à mon problème car je pense avoir compris la macro vérifie si la valeur en E3 se retrouve dans la BDD et seulement à ce moment là il recopie les valeurs associés.

Ce que je souhaite lors de la 2ème macro c'est qu'elle auto complète les champs entre la colonne F et X en les prenant dans la 1er feuille, c'est toujours les mêmes mais avec la méthode que j'emploi rien que pour une lignes il faut attendre environ 3 secondes donc je n'imagine pas pour 1000.

Je vais essayer de modifier la macro avec un isEmpty et je reviendrais vers vous si je n'ai peu de réponse jusqu'à là.

En attendant je repars dans mes tests.

A bientôt

Sadness
 

Grand Chaman Excel

XLDnaute Impliqué
Re : Concaténer cellule en VBA avec conditions

Bonjour sadness,
Désolé j'avais oublié de joindre le fichier la dernière fois et je l'ai effacé entre temps...
J'ai donc refait les macros dans le Module 4.

Pour ce qui est de ta demande de compléter les colonnes F à X, je ne sais pas quelles cellules de la 1re feuille doivent être copiées dans l'onglet Attest_BDD car tu as "anonymiser" ton fichier. Quelle cellule correspond à "Nom assuré", "Adresse assuré", etc.. ?

J'ai fait un petit essai dans le fichier joint (dont j'ai réduit la taille...). Tu pourras adapter à tes besoins.

A+
 

Pièces jointes

  • Copie de test050313.xls
    87 KB · Affichages: 20

sadness78

XLDnaute Junior
Re : Concaténer cellule en VBA avec conditions

Bonjour Grand chaman, le forum

J'ai retravaillé la macro pour correspondre au mieux à ma demande il ne me reste plus qu'un souci aux niveaux du isEmpty je pense avoir faire une erreur car que la colonne A soit remplis ou non il me copie les données là j'avoue je sèche.

Voici la macro modifié j'ai du faire une erreur :

Code:
Sub Copie_Launcher_vers_BDD()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rg As Range
    
    Set ws1 = ThisWorkbook.Sheets("Launcher")
    Set ws2 = ThisWorkbook.Sheets("Attest_BDD")
    
    Set rg = ws2.Range("A2:A60000")
    
    If IsEmpty(rg2) Then
       rg.Offset(0, 5) = ws1.Range("E3")   'Nom assuré
       rg.Offset(0, 6) = ws1.Range("E4")   'Adresse assuré
       rg.Offset(0, 7) = ws1.Range("E5")   'CP assuré
       rg.Offset(0, 8) = ws1.Range("E6")   'Ville assuré
       rg.Offset(0, 9) = ws1.Range("K3")   'Date d'effet
       rg.Offset(0, 10) = ws1.Range("K8")  'Date d'expiration
       rg.Offset(0, 11) = ws1.Range("")  'N° contrat
       rg.Offset(0, 12) = ws1.Range("E8")  'CDC
       rg.Offset(0, 13) = ws1.Range("E9") 'Tel
       rg.Offset(0, 14) = ws1.Range("E10") 'Fax
       rg.Offset(0, 15) = ws1.Range("E11") 'Email
       rg.Offset(0, 16) = ws1.Range("E12") 'Case Courrier
       rg.Offset(0, 17) = ws1.Range("E13") 'Branche
       rg.Offset(0, 18) = ws1.Range("E14") 'Signature
       rg.Offset(0, 19) = ws1.Range("E16") 'Couverture 1
       rg.Offset(0, 20) = ws1.Range("E17") 'Couverture 2
       rg.Offset(0, 21) = ws1.Range("E18") 'Couverture 3
       rg.Offset(0, 22) = ws1.Range("E19") 'Couverture 4
       rg.Offset(0, 23) = ws1.Range("E20") 'Couverture 5
       rg.Offset(0, 24) = ws1.Range("E21") 'Couverture 6
       rg.Offset(0, 25) = ws1.Range("E22") 'Couverture 7
       rg.Offset(0, 26) = ws1.Range("E23") 'Couverture 8
       rg.Offset(0, 27) = ws1.Range("E24") 'Couverture 9
       rg.Offset(0, 28) = ws1.Range("E25") 'Couverture 10
       rg.Offset(0, 29) = ws1.Range("E26") 'Couverture 11
       rg.Offset(0, 30) = ws1.Range("E27") 'Couverture 12
       rg.Offset(0, 31) = ws1.Range("E28") 'Couverture 13
       rg.Offset(0, 32) = ws1.Range("E29") 'Couverture 14
       rg.Offset(0, 33) = ws1.Range("E30") 'Couverture 15
       rg.Offset(0, 34) = ws1.Range("E31") 'Couverture 16
       rg.Offset(0, 35) = ws1.Range("E34") 'Zone commentaire
       rg.Offset(0, 36) = ws1.Range("E39") 'RR
          
   End If
   
End Sub

Cdlt,

Sadness

EDIT : J'ai compris la fonction Transpose mais je ne comprend pas le début avec le Resize
Code:
Resize(1, 16)

Je pense qu'entre les couvertures 1 à 16 je pourrais peut être écrire

Code:
 rg.Offset(0, 19).Resize(1, 16) = Application.Transpose(ws1.Range("E16:E31"))
 
Dernière édition:

Grand Chaman Excel

XLDnaute Impliqué
Re : Concaténer cellule en VBA avec conditions

Bonjour,

1)
L'erreur est sur la ligne
Code:
 If IsEmpty(rg2) Then
tu dois plutôt mettre
Code:
 If IsEmpty(rg) Then

car la variable "rg2" n'est pas utilisée dans cette macro.

2)
La fonction RESIZE sert à redimensionner la plage où tu va copier tes cellules.
Tu veux copier une plage de 16 lignes X 1 colonne dans 1 ligne X 16 colonnes.

Si tu fais sans le RESIZE, uniquement la 1re cellule sera copiée.

Code:
rg.Offset(0, 19)= Application.Transpose(ws1.Range("E16:E31"))

tnadis qu'avec

Code:
rg.Offset(0, 19).Resize(1, 16) = Application.Transpose(ws1.Range("E16:E31"))
tu dis à Excel: va copier le contenu de E16:E31 dans une plage de 1 ligne x 16 colonnes se trouvant à 19 colonnes à droite de la cellule "rg".

Donc ce que tu proposes pour les couvertures semble correct.

A+
 

sadness78

XLDnaute Junior
Re : Concaténer cellule en VBA avec conditions

Bonjour,

Merci pour le complément d'information sur le Resize.

Par contre j'ai bien fait la modification du rg mais aucune donnée ne va dans le tableau.

J'ai essayé en remplacant le IsEmpty par If Not IsEmpty et aussi par ceci
Code:
If rg <> " " Then
mais rien n'y fait.

Voici le code :

Code:
Sub Copie_Launcher_vers_BDD()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rg As Range
    
    Set ws1 = ThisWorkbook.Sheets("Launcher")
    Set ws2 = ThisWorkbook.Sheets("Attest_BDD")
    
    Set rg = ws2.Range("A2:A60000")
    
    If Not IsEmpty(rg) Then
       rg.Offset(0, 5) = ws1.Range("E3")   'Nom assuré
       rg.Offset(0, 6) = ws1.Range("E4")   'Adresse assuré
       rg.Offset(0, 7) = ws1.Range("E5")   'CP assuré
       rg.Offset(0, 8) = ws1.Range("E6")   'Ville assuré
       rg.Offset(0, 9) = ws1.Range("K3")   'Date d'effet
       rg.Offset(0, 10) = ws1.Range("K8")  'Date d'expiration
       rg.Offset(0, 11) = ws1.Range("")  'N° contrat
       rg.Offset(0, 12) = ws1.Range("E8")  'CDC
       rg.Offset(0, 13) = ws1.Range("E9") 'Tel
       rg.Offset(0, 14) = ws1.Range("E10") 'Fax
       rg.Offset(0, 15) = ws1.Range("E11") 'Email
       rg.Offset(0, 16) = ws1.Range("E12") 'Case Courrier
       rg.Offset(0, 17) = ws1.Range("E13") 'Branche
       rg.Offset(0, 18) = ws1.Range("E14") 'Signature
       rg.Offset(0, 19).Resize(1, 16) = Application.Transpose(ws1.Range("E16:E31")) 'Couvertures
       rg.Offset(0, 35) = ws1.Range("E34") 'Zone commentaire
       rg.Offset(0, 36) = ws1.Range("E39") 'RR
          
   End If
   
End Sub

Merci d'avance

A+
 

sadness78

XLDnaute Junior
Re : Concaténer cellule en VBA avec conditions

Re,

J'ai fait quelques autres test avec ceci :

Code:
Sub Copie_Launcher_vers_BDD()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rg As Range
    
    Set ws1 = ThisWorkbook.Sheets("Launcher")
    Set ws2 = ThisWorkbook.Sheets("Attest_BDD")
    
    Set rg = ws2.Range("A2:A60000")
    
    If IsEmpty(rg) Then
    
    Exit Sub
    Else
       rg.Offset(0, 5) = ws1.Range("E3")   'Nom assuré
       rg.Offset(0, 6) = ws1.Range("E4")   'Adresse assuré
       rg.Offset(0, 7) = ws1.Range("E5")   'CP assuré
       rg.Offset(0, 8) = ws1.Range("E6")   'Ville assuré
       rg.Offset(0, 9) = ws1.Range("K3")   'Date d'effet
       rg.Offset(0, 10) = ws1.Range("K8")  'Date d'expiration
       rg.Offset(0, 11) = ws1.Range("A1")  'N° contrat
       rg.Offset(0, 12) = ws1.Range("E8")  'CDC
       rg.Offset(0, 13) = ws1.Range("E9") 'Tel
       rg.Offset(0, 14) = ws1.Range("E14") 'Signature
       rg.Offset(0, 15).Resize(1, 16) = Application.Transpose(ws1.Range("E16:E31")) 'Couvertures
       rg.Offset(0, 31) = ws1.Range("E34") 'Zone commentaire
       rg.Offset(0, 32) = ws1.Range("E39") 'RR
          
   End If
   
End Sub

mais dans ce cas là il m'écrit bien les informations mais il ne fait pas de différence si la ligne est vide ou non donc il me copie les informations sur les 60 000 lignes. :mad:

Je continu les test au cas ou si je trouve.

A+
 

Grand Chaman Excel

XLDnaute Impliqué
Re : Concaténer cellule en VBA avec conditions

Bonjour,

En relisant, j'ai mieux compris ton problème. Je crois que tu n'as pas saisi la notion de
Code:
Set rg = ws2.Range("A2:A60000")

C'est normal que ça copie dans les 60000 lignes car tu as assigné la plage A2:A60000 à la variable rg.
Tu vérifie ensuite si elle est vide. Évidemment elle ne l'est pas car il y a des valeurs de A2:A30 dans ton fichier.
Ensuite tu copie les renseignements de l'onglet Launcher dans cette plage...

Voici la macro corrigée, la logique est la suivante :

1. au préalable, les sites ont été écrits dans l'onglet "Liste des sites"
2. la macro "Copie_Sites_vers_BDD" a été exécutée pour ajouter les nouveaux sites dans l'onglet Attest_BDD
3. des informations sont écrites dans l'onglet Launcher.
4. Le nom du site est écrit dans la cellule E3 de Launche (important)
5. On exécute la macro "Sub Copie_Launcher_vers_BDD"

Cette macro :
6. vérifier que la cellule E3 n'est pas vide. Si elle est vide un message s'affiche et la macro arrête.
7. Si la cellule n'est pas vide, recherche dans la plage A2:A60000 le nom du site de la cellule E3
8. si le site n'Est pas trouvé, un message s'affiche et la macro s'arrête. Retour au point 1
9. si le site est trouvé, copie des données sur la bonne ligne (la ligne de la variable "rg")

VB:
Sub Copie_Launcher_vers_BDD()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rg As Range
    
    Application.ScreenUpdating = False
    
    Set ws1 = ThisWorkbook.Sheets("Launcher")
    Set ws2 = ThisWorkbook.Sheets("Attest_BDD")
    
    If ws1.Range("E3") <> "" Then       'si la case E3 n'est pas vide alors
        Set rg = ws2.Range("A2:A60000").Find(ws1.Range("E3"), LookIn:=xlValues) 'plage de recherche
        If Not rg Is Nothing Then   'si le site écrit en E3 existe dans BDD, on écrit sur sa ligne
            rg.Offset(0, 4) = ws1.Range("E3")   'Nom assuré
            rg.Offset(0, 5) = ws1.Range("E4")   'Adresse assuré
            rg.Offset(0, 6) = ws1.Range("E5")   'CP assuré
            rg.Offset(0, 7) = ws1.Range("E6")   'Ville assuré
            rg.Offset(0, 8) = ws1.Range("K3")   'Date d'effet
            rg.Offset(0, 9) = ws1.Range("K8")  'Date d'expiration
            rg.Offset(0, 10) = ws1.Range("A1")  'N° contrat
            rg.Offset(0, 11) = ws1.Range("E8")  'CDC
            rg.Offset(0, 12) = ws1.Range("E9") 'Tel
            rg.Offset(0, 13) = ws1.Range("E14") 'Signature
            rg.Offset(0, 18).Resize(1, 16) = Application.Transpose(ws1.Range("E16:E31")) 'Couvertures
            rg.Offset(0, 33) = ws1.Range("E34") 'Zone commentaire
            rg.Offset(0, 34) = ws1.Range("E39") 'RR

        Else
            MsgBox "Site non trouvé"        ' le site écrit en E3 n'exite pas dans la BD.
        End If
    Else
        MsgBox "Valeur requise dans E3."
        
    End If
    
    Application.ScreenUpdating = True
End Sub

En espérant que ce soit plus clair ainsi...
A+
 

Pièces jointes

  • Copie de test050313 (1).xls
    92 KB · Affichages: 29

sadness78

XLDnaute Junior
Re : Concaténer cellule en VBA avec conditions

Bonjour de si bon matin Grand Chaman, le Forum,

Je pense avoir compris mais comme je l'ai mis dans le post 17, suite à la copie des sites sur Attest_BDD j'aimerais copier les mêmes données à tout les sites en provenance du « Launcher » et seulement sur les lignes remplis.

A l'époque je l'avais fait avec un SI(ESTVIDE(A1);"";E3) et j'avais copié cette formule sur 10000 lignes sur toutes les colonnes ce qui m’ouvrait une nouvelle problématique : la taille de mon fichier qui avait pris une taille disproportionnée (environ 20Mo).

A bientôt.

Sad

EDIT : En me relisant je me trouve moins clair :( , je ne cherche pas a vérifier si le site existe, là je fais confiance en amont lors du remplissage je cherche juste à associer la liste des sites aux informations du Launcher seulement pour les lignes remplies.
 
Dernière édition:

Grand Chaman Excel

XLDnaute Impliqué
Re : Concaténer cellule en VBA avec conditions

Bonjour,

Je pense avoir compris mais comme je l'ai mis dans le post 17, suite à la copie des sites sur Attest_BDD j'aimerais copier les mêmes données à tout les sites en provenance du « Launcher » et seulement sur les lignes remplis.

Je ne suis plus certain de te suivre...:confused:

Que veux-tu dire par
j'aimerais copier les mêmes données à tout les sites en provenance du « Launcher » et seulement sur les lignes remplis

Tu as un site à la fois dans l'onglet "Launcher" et ce site se trouve sur une seule ligne dans l'onglet "Attest_BDD". Tu ne peux donc remplir qu'une seule ligne à la fois.

Tu dis aussi,
je ne cherche pas a vérifier si le site existe, là je fais confiance en amont lors du remplissage je cherche juste à associer la liste des sites aux informations du Launcher seulement pour les lignes remplies.

La macro vérifie si le site existe (comme je l'ai expliqué au point 7 de mon message précédent). Si tout a bien été fait, le site sera trouvé et les informations de "Launcher" seront recopiées dans "Attest_BDD". (donc le point 8 ne sera jamais executé...)

As-tu testé la macro?

A+
 

sadness78

XLDnaute Junior
Re : Concaténer cellule en VBA avec conditions

Bonjour,

Oui j'ai testé la macro c'est exactement ce que j'espérais avoir à ceci prêt qu'il ne copie que pour un site.

J'ai fais deux Screenshots pour essayer d'être plus clair, désolé pour mes mauvaises explications Grand Chaman, à force de travailler avec je m’explique pas forcément très bien.

En tout cas merci beaucoup pour le temps déjà passé.
 

Pièces jointes

  • Images.zip
    26.7 KB · Affichages: 17
  • Images.zip
    26.7 KB · Affichages: 16
  • Images.zip
    26.7 KB · Affichages: 17

Grand Chaman Excel

XLDnaute Impliqué
Re : Concaténer cellule en VBA avec conditions

Bonjour,
Il y a un détail que je ne saisi pas...
Je répétè ce que je comprends :
- Dans "Attest_BDD" tu as une liste de sites. Et d'après ce que je comprends tous ces sites sont différents. Et dans cette liste, tu ne fera qu'àjouter des sites.
- Dans Launcher, tu entres un site à la fois. Tu veux copier les informations de CE site dans la bonne ligne de Attest_BDD.

Je ne comprends pas quand tu dis :
j'espérais avoir à ceci prêt qu'il ne copie que pour un site.

C'est normal, selon moi, qu'il copie pour un site à la fois....

Si je suis dans les patates, explique moi étape par étape comment tu vas utiliser le fichier.

A+
 

Discussions similaires

Réponses
11
Affichages
347
Réponses
1
Affichages
195