XL 2016 Récupération de lettre dans cellule

[Fipat]

Bonjour,

Je cherche à récupérer les trois dernière lettre d'un mot dans une cellule et les trois premières lettre dans une autre cellule.
Au lieu d'avoir mes lettres, le me retrouve avec des chiffres.
Dans l’exemple ci-joint mon résultat devrait être "pinCer", alors cela me donne 22.
Merci pour votre aide.

 

[Staple1600]

Bonjour Fipat, le fil

C'est normal, non,

Sub test()
Dim Ch As Long, Ch2 As Long, rslt As Long
Dim txt As String, txt2 As String
Ch = WorksheetFunction.CountA(Sheets("Feuil1").Range("B:B"))
MsgBox Ch, vbInformation, "Valeur: Ch"
Ch2 = WorksheetFunction.CountA(Sheets("Feuil1").Range("C:C"))
MsgBox Ch2, vbInformation, "Valeur: Ch2"
txt = Right(Ch, 3)
MsgBox txt, vbInformation, "Valeur: txt"
txt2 = Left(Ch2, 3)
MsgBox txt2, vbInformation, "Valeur: txt2"
MsgBox txt & txt2, vbInformation, "Valeur: txt & txt2"
End Sub

NB: Ajouter une MsgBox pour tester son code VBA permet souvent de comprendre le pourquoi du comment.

 

[Staple1600]

Re

Si j'ai compris ce que tu veux faire, tu peux passer par une fonction VBA personnalisée

Function mafonction(r As Range) As String
mafonction = r.Row & "_" & Left(r, 3) & Right(r.Offset(, 1), 3)
End Function

Et tu saisis en A2
=mafonction(B2)
ce qui renvoie
2_Laperf

 

[M12]

Bonjour
Teste comme ceci

 

[Staple1600]

Bonjour M12

=>Fipat
Ce serait plutôt (j'ai relu le premier message)

Function mafonction(r As Range) As String
mafonction = r.Row & "_" & Right(r, 3) & Left(r.Offset(, 1), 3)
End Function

Et là, la fonction renvoie: 2_pinCer

EDITION: Bonjour à toi également, soan ...

 

[soan]

Bonjour Fipat, lefil,

ton fichier en retour. dommage qu'il n'y avait qu'un seul exemple !

ton exo aurait été plus sympa avec toute une liste en colonnes B et C !
mais si tu ajoutes des lignes, ma macro les prendra en compte.

Sub test()
  If ActiveSheet.Name <> "Feuil1" Then Exit Sub
  Dim dlg&, lig&: Application.ScreenUpdating = 0
  Columns(1).ClearContents: [A1] = "Résultat"
  dlg = Cells(Rows.Count, 2).End(3).Row
  For lig = 2 To dlg
    With Cells(lig, 2)
      If .Value <> "" Then
        .Offset(, -1) = "ligne n° " & lig & " : " & _
          Right$(.Value, 3) & LCase$(Left$(.Offset(, 1), 3))
      End If
    End With
  Next lig
End Sub

soan

 

[Fipat]

Bonjour, merci pour ces réponses.
Soan, M12, c'est exactement ce que je recherche
Je n'aurais pas pensé passer par une boucle.
Staple1600, non pas une fonction, mais ceci dit, très intéressante ta proposition.
Merci à tous.

 

[Staple1600]

Re

=>Fipat
J'ai édité mon premier message
Avec cette astuce, tu aurais trouvé tout seul pourquoi tu obtenais 22

 

[Staple1600]

Re

Sans boucle, sans fonction VBA personnalisée

Sub Macro1()
Dim DLig&
DLig = Cells(Rows.Count, 2).End(3).Row
Range("B2:B" & DLig).TextToColumns Destination:=Range("D2"), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 9), Array(2, 1))
Range("C2:C" & DLig).TextToColumns Destination:=Range("E2"), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(3, 9))
Range("A2:A" & DLig) = "=ROW()&""_""&RC[3]&RC[4]"
Range("A2:A" & DLig) = Range("A2:A" & DLig).Value
Range("D:E").Clear
End Sub

NB: Test OK sur l'exemple tel que présenté dans le message#1
(j'ai rempli les colonnes A et B avec des mots aléatoires d'au moins 5 lettres pour faire mon test)

 

[soan]

@Fipat

note que la macro du fichier de mon post #6 :

* efface la colonne A des anciens résultats, pour éviter toute « interférence »
entre d'anciens résultats et les nouveaux.

* écrit un résultat seulement s'il y a une donnée en cellule B (pour une
ligne donnée)

* utilisation de LCase$() pour avoir "pincer" au lieu de "pinCer"

* en prime, présentation de la feuille améliorée : largeur des
colonnes, et alignement gauche avec retrait de 1.

soan

 

[Staple1600]

Re

Correction de la macro du message#9

Sub Macro1_b()
Dim DLig&
DLig = Cells(Rows.Count, 2).End(3).Row
Range("D2:D" & DLig).Formula = "=RIGHT(B2,3)"
Range("C2:C" & DLig).TextToColumns Destination:=Range("E2"), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(3, 9))
Range("A2:A" & DLig) = "=ROW()&""_""&RC[3]&RC[4]"
Range("A2:A" & DLig) = Range("A2:A" & DLig).Value
Range("D:E").Clear
End Sub

Toujours sans boucle et sans fonction VBA personnalisée

=> soan : pas de croissants aujourd'hui?

 

[soan]

Bonjour Staple,

il me reste encore des pâtisseries d'hier ! j'en ai pris 6, mais j'les mange pas
toutes d'un coup, sinon j'vais faire une indigestion et être malade ! faut savoir
être raisonnable, hein ? (n'est-ce pas les gourmands ! )

soan

 

[Fipat]

Merci à tous, pleins de solution