Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Extraire par la gauche

Extraire par la gauche

13 réponses
Avatar
Vincent
Bonjour.
J'ai dans une cellule A1 un mot par ex : bonjour
Je souhaite avoir en B1 la 1 ère lettre soit "b", puis en C1 "o", puis en D1
"n" etc.
Mais, je ne me souviens plus de la fonction afin d'extraire par la gauche
dans l'ordre
Merci beaucoup.
Vincent
Signaler un problème avec ce contenu

3 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
Vincent
Merci encore Joël
Aurais-tu une procédure qui me donne si je saisi "ton"en A1
la combinaison de ces 3 lettres dans chaque cellules, ex :
avec ta proc j'ai en A2 "t" en A3 "o" en A4 "n"
soit en B2 "o" en B3 "t" en B4 "n"
soit en C2 "n" en C3 "o" en C4 "t" etc.
P.S.
Ton site est vraiment très sympa
Bonne soirée
Vincent

"Joël GARBE" a écrit dans le message de
news:4160246e$0$22578$
Ce fut un plaisir

;-)

--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr
"Vincent" a écrit dans le message de news:

Opus pardon Joël
effectivement cela fonctionne parfaitement
Merci beaucoup,
bonne journée.
Vincent


"Joël GARBE" a écrit dans le message de
news:415fd6ea$0$3081$
Bonjour,

Une peite macro ?

Sub Extraire()
Dim i As Integer
If Range("A1") = "" Then Exit Sub
For i = 1 To Len(Range("A1"))
Cells(1, i + 1) = Mid(Range("A1"), i, 1)
Next
End Sub


--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr
"Vincent" a écrit dans le message de news:
OpuOT$
Bonjour.
J'ai dans une cellule A1 un mot par ex : bonjour
Je souhaite avoir en B1 la 1 ère lettre soit "b", puis en C1 "o",
puis




en
D1
"n" etc.
Mais, je ne me souviens plus de la fonction afin d'extraire par la
gauche


dans l'ordre
Merci beaucoup.
Vincent
















Avatar
sabatier
non, vincent, avec la proc de joel, tu as :
t en B1, o en C1 et n en D1...
enfin c'est ainsi que j'ai compris...
jps (qui part dans le chaudron des verts)

"Vincent" a écrit dans le message de
news:
Merci encore Joël
Aurais-tu une procédure qui me donne si je saisi "ton"en A1
la combinaison de ces 3 lettres dans chaque cellules, ex :
avec ta proc j'ai en A2 "t" en A3 "o" en A4 "n"
soit en B2 "o" en B3 "t" en B4 "n"
soit en C2 "n" en C3 "o" en C4 "t" etc.
P.S.
Ton site est vraiment très sympa
Bonne soirée
Vincent

"Joël GARBE" a écrit dans le message de
news:4160246e$0$22578$
Ce fut un plaisir

;-)

--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr
"Vincent" a écrit dans le message de news:

Opus pardon Joël
effectivement cela fonctionne parfaitement
Merci beaucoup,
bonne journée.
Vincent


"Joël GARBE" a écrit dans le message de
news:415fd6ea$0$3081$
Bonjour,

Une peite macro ?

Sub Extraire()
Dim i As Integer
If Range("A1") = "" Then Exit Sub
For i = 1 To Len(Range("A1"))
Cells(1, i + 1) = Mid(Range("A1"), i, 1)
Next
End Sub


--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr
"Vincent" a écrit dans le message de news:
OpuOT$
Bonjour.
J'ai dans une cellule A1 un mot par ex : bonjour
Je souhaite avoir en B1 la 1 ère lettre soit "b", puis en C1 "o",
puis




en
D1
"n" etc.
Mais, je ne me souviens plus de la fonction afin d'extraire par la
gauche


dans l'ordre
Merci beaucoup.
Vincent




















Avatar
Joël GARBE
Bonsoir Vincent,

Merci pour la remarque ;-)

Voici une adaptation du code trouvé grâce au lien de FxM par ailleurs
http://www.excelabo.net/xl/fonctions.php#combinaisonspermutations

dans un premier module, modification du code :
'============================================= Option Explicit

Sub Extraire(ByVal KelCell As Range)
Dim i As Integer
If KelCell = "" Then Exit Sub
For i = 1 To Len(KelCell)
Cells(KelCell.Row, i + 1) = Mid(KelCell, i, 1)
Next
End Sub


'============================================= dans un second module : ajouer le code suivant :
'============================================= Option Explicit

Dim vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet

Sub ListPermutations()
Dim Rng As Range
Dim PopSize As Integer
Dim SetSize As Integer
Dim Which As String
Dim N As Double
Const BufferSize As Long = 4096

'Set Rng = Selection.Columns(1).Cells
'If Rng.Cells.Count = 1 Then
' Set Rng = Range(Rng, Rng.End(xlDown))
'End If

'PopSize = Rng.Cells.Count - 2
'If PopSize < 2 Then GoTo DataError

SetSize = Len(Range("A1")) 'Rng.Cells(2).Value
'If SetSize > PopSize Then GoTo DataError
PopSize = SetSize
Which = "P" 'UCase$(Rng.Cells(1).Value)
Select Case Which
Case "C"
N = Application.WorksheetFunction.Combin(PopSize, SetSize)
Case "P"
N = Application.WorksheetFunction.Permut(PopSize, SetSize)
Case Else
GoTo DataError
End Select
'If N > Cells.Count Then GoTo DataError

Application.ScreenUpdating = False

Set Results = ActiveSheet 'Worksheets.Add
'vAllItems = Rng.Offset(2, 0).Resize(PopSize).Value
vAllItems = Range(Range("B1"), Range("IV1").End(xlToLeft)).Value
ReDim Buffer(1 To BufferSize) As String
BufferPtr = 0

If Which = "C" Then
AddCombination PopSize, SetSize
Else
AddPermutation PopSize, SetSize
End If
vAllItems = 0
Dim oCell As Range
For Each oCell In Selection
Extraire oCell
Next
Selection.ClearContents
Application.ScreenUpdating = True
Exit Sub

DataError:
If N = 0 Then
Which = "Enter your data in a vertical range of at least 4 cells. " _
& String$(2, 10) _
& "Top cell must contain the letter C or P, 2nd cell is the number" _
& "of items in a subset, the cells below are the values from which" _
& "the subset is to be chosen."
Else
Which = "This requires " & Format$(N, "#,##0") & _
" cells, more than are available on the worksheet!"
End If
MsgBox Which, vbOKOnly, "DATA ERROR"
Exit Sub
End Sub

Private Sub AddPermutation(Optional PopSize As Integer = 0, _
Optional SetSize As Integer = 0, _
Optional NextMember As Integer = 0)

Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Static Used() As Integer
Dim i As Integer

If PopSize <> 0 Then
iPopSize = PopSize
iSetSize = SetSize
ReDim SetMembers(1 To iSetSize) As Integer
ReDim Used(1 To iPopSize) As Integer
NextMember = 1
End If

For i = 1 To iPopSize
If Used(i) = 0 Then
SetMembers(NextMember) = i
If NextMember <> iSetSize Then
Used(i) = True
AddPermutation , , NextMember + 1
Used(i) = False
Else
SavePermutation SetMembers()
End If
End If
Next i

If NextMember = 1 Then
SavePermutation SetMembers(), True
Erase SetMembers
Erase Used
End If

End Sub 'AddPermutation

Private Sub AddCombination(Optional PopSize As Integer = 0, _
Optional SetSize As Integer = 0, _
Optional NextMember As Integer = 0, _
Optional NextItem As Integer = 0)

Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Dim i As Integer

If PopSize <> 0 Then
iPopSize = PopSize
iSetSize = SetSize
ReDim SetMembers(1 To iSetSize) As Integer
NextMember = 1
NextItem = 1
End If

For i = NextItem To iPopSize
SetMembers(NextMember) = i
If NextMember <> iSetSize Then
AddCombination , , NextMember + 1, i + 1
Else
SavePermutation SetMembers()
End If
Next i

If NextMember = 1 Then
SavePermutation SetMembers(), True
Erase SetMembers
End If

End Sub 'AddCombination

Private Sub SavePermutation(ItemsChosen() As Integer, _
Optional FlushBuffer As Boolean = False)

Dim i As Integer, sValue As String
Static RowNum As Long, ColNum As Long

If RowNum = 0 Then RowNum = 1
If ColNum = 0 Then ColNum = 1

If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then
If BufferPtr > 0 Then
If (RowNum + BufferPtr - 1) > Rows.Count Then
RowNum = 1
ColNum = ColNum + 1
If ColNum > 256 Then Exit Sub
End If

Results.Cells(RowNum, ColNum).Resize(BufferPtr, 1).Value _
= Application.WorksheetFunction.Transpose(Buffer())
RowNum = RowNum + BufferPtr
End If

BufferPtr = 0
If FlushBuffer = True Then
Erase Buffer
RowNum = 0
ColNum = 0
Exit Sub
Else
ReDim Buffer(1 To UBound(Buffer))
End If

End If

'construct the next set
For i = 1 To UBound(ItemsChosen)
sValue = sValue & vAllItems(1, ItemsChosen(i))
Next i

'and save it in the buffer
BufferPtr = BufferPtr + 1
Buffer(BufferPtr) = sValue 'Mid$(sValue, 3)
End Sub 'SavePermutation

'=============================================
--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr
"Vincent" a écrit dans le message de news:

Merci encore Joël
Aurais-tu une procédure qui me donne si je saisi "ton"en A1
la combinaison de ces 3 lettres dans chaque cellules, ex :
avec ta proc j'ai en A2 "t" en A3 "o" en A4 "n"
soit en B2 "o" en B3 "t" en B4 "n"
soit en C2 "n" en C3 "o" en C4 "t" etc.
P.S.
Ton site est vraiment très sympa
Bonne soirée
Vincent

"Joël GARBE" a écrit dans le message de
news:4160246e$0$22578$
Ce fut un plaisir

;-)

--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr
"Vincent" a écrit dans le message de news:

Opus pardon Joël
effectivement cela fonctionne parfaitement
Merci beaucoup,
bonne journée.
Vincent


"Joël GARBE" a écrit dans le message de
news:415fd6ea$0$3081$
Bonjour,

Une peite macro ?

Sub Extraire()
Dim i As Integer
If Range("A1") = "" Then Exit Sub
For i = 1 To Len(Range("A1"))
Cells(1, i + 1) = Mid(Range("A1"), i, 1)
Next
End Sub


--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr
"Vincent" a écrit dans le message de news:
OpuOT$
Bonjour.
J'ai dans une cellule A1 un mot par ex : bonjour
Je souhaite avoir en B1 la 1 ère lettre soit "b", puis en C1 "o",
puis




en
D1
"n" etc.
Mais, je ne me souviens plus de la fonction afin d'extraire par la
gauche


dans l'ordre
Merci beaucoup.
Vincent




















1 2