Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 mid avec plusieurs mots

Yves du calvados

XLDnaute Nouveau
Bonjouoor à tous,
j'aurais besoin d'une petite aide concernant la fonction mid

j'ai une liste de dis mots de mot1 à mot10.
je souhaiterais prendre, pour le premiere ligne (premlig), la premiere lettre de chaque mot, ce qui donnerait "aecvrrtsc"
ma variable mot & b ne fonctionne pas; je dois oublier quelque chose. j'obtiens "12345678910"
vous troucerez ci-dessous ma macro.
merci à tous pour votre aide
Cordialement

Sub tri()
mot1 = Range("C6").Value 'amputeriez
mot2 = Range("C7").Value 'encensasse
mot3 = Range("C8").Value 'caressasse
mot4 = Range("C9").Value 'engueulade
mot5 = Range("C10").Value 'voltigeais
mot6 = Range("C11").Value 'remanieras
mot7 = Range("C12").Value 'rappointis
mot8 = Range("C13").Value 'tintassiez
mot9 = Range("C14").Value 'séjournons
mot10 = Range("b1").Value 'contentant

premlig = ""
For a = 1 To 10
For b = 1 To 10
premlig = premlig + Mid(mot & b, a, 1)
Next b
Next a
MsgBox premlig
' aecvrrtsc
End Sub
 
Solution
Bonjour @Yves du calvados

Je te propose plutôt ceci:
VB:
Sub Tri()
Dim i&, PremLig$, x$
For i = 6 To 14
    x = Left(Range("C" & i), 1)
    PremLig = PremLig & x
Next i
PremLig = PremLig & Left([B1], 1)
MsgBox PremLig
End Sub

Edit pour "Mid"
Et si tu veux à tout prix te servir de "Mid"
VB:
Sub TriMid()
Dim i&, PremLig$, x$
For i = 6 To 14
    x = Mid(Range("C" & i), 1, 1)
    PremLig = PremLig & x
Next i
PremLig = PremLig & Mid([B1], 1, 1)
MsgBox PremLig
End Sub

Merci de ton retour

@Phil69970

Phil69970

XLDnaute Barbatruc
Bonjour @Yves du calvados

Je te propose plutôt ceci:
VB:
Sub Tri()
Dim i&, PremLig$, x$
For i = 6 To 14
    x = Left(Range("C" & i), 1)
    PremLig = PremLig & x
Next i
PremLig = PremLig & Left([B1], 1)
MsgBox PremLig
End Sub

Edit pour "Mid"
Et si tu veux à tout prix te servir de "Mid"
VB:
Sub TriMid()
Dim i&, PremLig$, x$
For i = 6 To 14
    x = Mid(Range("C" & i), 1, 1)
    PremLig = PremLig & x
Next i
PremLig = PremLig & Mid([B1], 1, 1)
MsgBox PremLig
End Sub

Merci de ton retour

@Phil69970
 
Dernière édition:

Phil69970

XLDnaute Barbatruc

Pièces jointes

  • 1ere lettre de chaque mot V2.xlsm
    20.8 KB · Affichages: 3

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour à @Yves du calvados , à @Phil69970 , @ChTi160 , @chris ,

Une autre fonction personnalisée qui accepte un nombre variable de plages ( de 0 à n).
Exemple d'utilisation :
  • =PremCar(C6:C14;B1) sur une feuille de calcul
  • =PremCar([C6:C14] , [B1]) dans un code VBA
Voir les formules des cellules E1 et H1.

Le code est dans module1:
VB:
Function PremCar$(ParamArray plages())
Dim x, c, res$
   For Each x In plages: For Each c In x: res = res & Left(c, 1): Next c, x
   PremCar = res
End Function
 

Pièces jointes

  • Yves du calvados- PremCar- v1.xlsm
    17 KB · Affichages: 2
Dernière édition:

chris

XLDnaute Barbatruc
RE

Pour le fun une fonction personnalisée, qui comme FILTRE ou autres fonctions matricielles nécessite qu'il y ait assez de cellule libres

VB:
Function JT_par_L(Plage As Range)
   
    With Plage.Cells
        If .Cells.Count = 1 Then JT_par_L = ""
        Dim Liste
        ReDim Liste(1, .Cells.Count)
        x = Len(.Cells(1).Value)
        For i = 2 To .Cells.Count
            x = WorksheetFunction.Max(Len(.Cells(i).Value), x)
        Next i
        For j = 1 To x
            For i = 1 To .Cells.Count
                Liste(1, j) = Liste(1, j) & Mid(.Cells(i), j, 1)
            Next i
        Next j
    End With
        JT_par_L = Application.Transpose(Liste)
End Function

EDIT : ya plus qu'à mixer tout cela, lol
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Re,

Pas vu que vous disposez de Office 365. Donc c'est plus simple et ça se fait par formule sans VBA:
VB:
=CONCAT(GAUCHE(C6:C14;1);GAUCHE(B1;1))

Voir cellules E2 et H2 dans le fichier joint.
 

Pièces jointes

  • Yves du calvados- PremCar- v2.xlsx
    11.2 KB · Affichages: 1
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…