XL 2016 Concatener et suppression caractères

Fipat

XLDnaute Occasionnel
Bonjour,

Je galère depuis quelques heures sur une situation.
J'ai construit un userform avec 7 bases que je vais remplir dans une feuille nommée "Paramétrages".
J’affiche sur 7 cellule en colonne C (soit de C6 à C12) ces extractions depuis mon userform.

En C8 j'ai par exemple (extraction qui peut être bien plus longue), cela donne : BM, MT, NT
En C11 J'ai idem une extraction qui peu-être plus longue, cela donne : 14*..15*..21*..30*
En C12, j'affiche une seule lettre qui peut-être M ou C... en tout 7 lettre, cela donne (en exemple) : M
Je voudrais et cherche à concaténer ce petit monde et donc écraser la cellule C12 pour que cela me donne en C12 :
BMM14*,BMM15*,BMM21*,BMM30*, MTM14*,MTM15*,MTM21*,MTM30*, NTM14*,NTM15*,NTM21*,NTM30*

Par avance merci.

Pardon je complète ma demande.
Pour afficher en C8
Je fait :
VB:
Private Sub Btn_Ajout_Agence_Click()
Application.ScreenUpdating = False
Dim Agence As String
Dim Nc, Cel As Range
Agence = Lbx_Agence.Value
Tbx_Agence = Agence & "," & Tbx_Agence
With Sheets("Paramétrages")
         .[C8].Value = Tbx_Agence.Value
    End With
    Application.ScreenUpdating = True
End Sub

Pour C11 :

Code:
Private Sub Btn_Ajout_Famille_Click()
Application.ScreenUpdating = False
Dim Famille As String
Dim Nc, Cel As Range
Famille = Lbx_Famille.Value
Tbx_Famille = Famille & ".." & Tbx_Famille
With Sheets("Paramétrages")
        .[C11].Value = Tbx_Famille.Value
    End With
    Application.ScreenUpdating = True
End Sub

Et en C12
Code:
Private Sub Btn_Ajout_Sections_Click()
Application.ScreenUpdating = False
Dim Sections As String, LectureAG As String
Dim Nc, Cel As Range
Sections = Lbx_Sections.Value
Tbx_Sections = Sections & "," & Tbx_Sections
With Sheets("Paramétrages")
        LectureAG = .[C12].Value ' Et c'est ici que tout ce complique
        .[C12].Value = Tbx_Sections.Value ' écraser la valeur pour concaténer C..
    End With
    Application.ScreenUpdating = True
End Sub

Ah oui pour nettoyer et avoir l'affichage désiré en C11 je fais via un autre bouton :
VB:
Private Sub Btn_Valide_Famille_Click() ' suppression dernier caractère & espace famille
Application.ScreenUpdating = False
With Sheets("Paramétrages")
Dim Nc, Cel As Range
    For Each Cel In Range("C11")
        Cel.Value = Trim(Cel.Value) 'supprime espaces
        Nc = Len(Cel)               'compte les caractères
        Cel.Value = Left(Cel, Nc - 2)
    Next Cel
    End With
Application.ScreenUpdating = True
End Sub
 
Dernière édition:

Fipat

XLDnaute Occasionnel
Bonjour Staple1600,

Désolé mais ayant répondu en résolu je n'étais pas revenu sur ce sujet.
Oui j'ai testé ta réponse, mais j'avais un message d'erreur et ayant eu une solution de Jacky67 qui allez bien, je ne pas chercher à comprendre d’où venez cette erreur.
Cette demande vient du même classeur que j'ai construit hier après midi avec ce sujet que tu remontes.
Encore désolé de ne pas fait un retour.
Je prends note que même si je réponds en résolu je ferais un retour aux propositions données.
 

Fipat

XLDnaute Occasionnel
J'ai réussit à faire ce que je voulais, bon certes un peu long mais ça fonctionne :)
Par contre si fais demande trop longue je n'arrive pas à tout afficher c'est comme le cellule ne voulais plus de caractères.
Mais je ne ferais jamais de requête aussi longue.
VB:
Private Sub Btn_Valider_Sections_Click() 
Application.ScreenUpdating = False
With Sheets("Paramétrages")
Dim Nc, Cel As Range
Dim LectSc, LectAg, LectFa, CSections, Ag, Recup, Cfa, RecSec  As String
Dim a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y, z As String
CSections = Tbx_Sections.Value
If CSections = "" Then Exit Sub
    For Each Cel In Range("C12")
        Cel.Value = Trim(Cel.Value) 
        Nc = Len(Cel)              
        Cel.Value = Left(Cel, Nc - 1)
    Next Cel
    LectAg = .[C8].Value
    LectFa = .[C11].Value
    LectSc = .[C12].Value
    Recup = Left(LectFa, 2)
    Ag = Replace(LectAg, ",", LectSc & Recup & "*,")
    Sheets("Paramétrages").[C12] = Ag
    Cfa = Len(LectFa)
    If Cfa > 4 Then
     RecSec = Mid(LectFa, 5, 2)
     a = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a
    End If
    If Cfa > 8 Then
     RecSec = Mid(LectFa, 9, 2)
     b = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b
    End If
    If Cfa > 12 Then
     RecSec = Mid(LectFa, 13, 2)
     c = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c
    End If
    If Cfa > 16 Then
     RecSec = Mid(LectFa, 17, 2)
     d = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d
    End If
    If Cfa > 20 Then
     RecSec = Mid(LectFa, 21, 2)
     e = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d & e
    End If
    If Cfa > 24 Then
     RecSec = Mid(LectFa, 25, 2)
     f = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d & e & f
    End If
    If Cfa > 28 Then
     RecSec = Mid(LectFa, 29, 2)
     g = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d & e & f & g
    End If
    If Cfa > 32 Then
     RecSec = Mid(LectFa, 33, 2)
     h = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d & e & f & g & h
    End If
    If Cfa > 36 Then
     RecSec = Mid(LectFa, 37, 2)
     i = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d & e & f & g & h & i
    End If
    If Cfa > 40 Then
     RecSec = Mid(LectFa, 41, 2)
     j = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d & e & f & g & h & i & j
    End If
    If Cfa > 44 Then
     RecSec = Mid(LectFa, 45, 2)
     k = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d & e & f & g & h & i & j & k
    End If
    If Cfa > 48 Then
     RecSec = Mid(LectFa, 49, 2)
     l = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d & e & f & g & h & i & j & k & l
    End If
    If Cfa > 52 Then
     RecSec = Mid(LectFa, 53, 2)
     m = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d & e & f & g & h & i & j & k & l & m
    End If
    If Cfa > 56 Then
     RecSec = Mid(LectFa, 57, 2)
     n = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d & e & f & g & h & i & j & k & l & m & n
    End If
    If Cfa > 60 Then
     RecSec = Mid(LectFa, 61, 2)
     o = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d & e & f & g & h & i & j & k & l & m & n & o
    End If
    If Cfa > 64 Then
     RecSec = Mid(LectFa, 65, 2)
     p = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d & e & f & g & h & i & j & k & l & m & n & o & p
    End If
    If Cfa > 68 Then
     RecSec = Mid(LectFa, 69, 2)
     q = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d & e & f & g & h & i & j & k & l & m & n & o & p & q
    End If
    If Cfa > 72 Then
     RecSec = Mid(LectFa, 73, 2)
     r = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d & e & f & g & h & i & j & k & l & m & n & o & p & q & r
    End If
    If Cfa > 76 Then
     RecSec = Mid(LectFa, 77, 2)
     s = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d & e & f & g & h & i & j & k & l & m & n & o & p & q & r & s
    End If
    If Cfa > 80 Then
     RecSec = Mid(LectFa, 81, 2)
     t = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d & e & f & g & h & i & j & k & l & m & n & o & p & q & r & s & t
    End If
    If Cfa > 84 Then
     RecSec = Mid(LectFa, 85, 2)
     u = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d & e & f & g & h & i & j & k & l & m & n & o & p & q & r & s & t & u
    End If
    If Cfa > 88 Then
     RecSec = Mid(LectFa, 89, 2)
     v = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d & e & f & g & h & i & j & k & l & m & n & o & p & q & r & s & t & u & v
    End If
    If Cfa > 92 Then
     RecSec = Mid(LectFa, 93, 2)
     w = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d & e & f & g & h & i & j & k & l & m & n & o & p & q & r & s & t & u & v & w
    End If
    If Cfa > 96 Then
     RecSec = Mid(LectFa, 97, 2)
     x = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d & e & f & g & h & i & j & k & l & m & n & o & p & q & r & s & t & u & v & w & x
    End If
    If Cfa > 100 Then
     RecSec = Mid(LectFa, 101, 2)
     y = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d & e & f & g & h & i & j & k & l & m & n & o & p & q & r & s & t & u & v & w & x & y
    End If
    If Cfa > 104 Then
     RecSec = Mid(LectFa, 105, 2)
     z = Replace(LectAg, ",", LectSc & RecSec & "*,")
     Sheets("Paramétrages").[C12] = Ag & a & b & c & d & e & f & g & h & i & j & k & l & m & n & o & p & q & r & s & t & u & v & w & x & y & z
    End If
    End With
Application.ScreenUpdating = True
End Sub
 

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 105
Messages
2 085 350
Membres
102 870
dernier inscrit
Armisa