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
Filochard
j'ai trois cellules ayant pour valeur A B C comment puis-je obtenir ce résultat
ABC ACB BAC BCA CAB CBA
En utilisant la feuille de calcul et pas de tableau en mémoire et à partir d'une feuille vide :
Sub Combine_Lettres() Range("A1").CurrentRegion.ClearContents x% = 3 'nombre de lettres (A,B,C,D....) à adapter ou initialiser avec InputBox Application.ScreenUpdating = False For nb% = 1 To x Cells(nb, 1) = Chr(64 + nb) Next Cells(x, 1).Select encore: Set plage = Range(Cells(1, ActiveCell.Column), ActiveCell) plage.Cells(1).Offset(0, 1).Select For Each cel In plage For nb = 1 To x ActiveCell = cel & Chr(64 + nb) ActiveCell.Offset(1, 0).Select Next nb Next cel ActiveCell.Offset(-1, 0).Select If ActiveCell.Column < x Then GoTo encore laCol = ActiveCell.Column laLg = ActiveCell.Row
For i = laLg To 1 Step -1 For j = 1 To Len(Cells(i, laCol)) Ltt$ = Mid(Cells(i, laCol), j, 1) If Len(Application.Substitute(Cells(i, laCol), Ltt, "")) <> Len(Cells(i, laCol)) - 1 Then Cells(i, laCol).Delete Exit For End If Next j Next i Range("B:" & Split(Cells(1, laCol - 1).Address, "$")(1)).Delete End Sub
http://cjoint.com/?jwswAUfzk6
j'ai trois cellules ayant pour valeur A B C
comment puis-je obtenir ce résultat
ABC
ACB
BAC
BCA
CAB
CBA
En utilisant la feuille de calcul et pas de tableau en mémoire et à partir d'une
feuille vide :
Sub Combine_Lettres()
Range("A1").CurrentRegion.ClearContents
x% = 3 'nombre de lettres (A,B,C,D....) à adapter ou initialiser avec InputBox
Application.ScreenUpdating = False
For nb% = 1 To x
Cells(nb, 1) = Chr(64 + nb)
Next
Cells(x, 1).Select
encore:
Set plage = Range(Cells(1, ActiveCell.Column), ActiveCell)
plage.Cells(1).Offset(0, 1).Select
For Each cel In plage
For nb = 1 To x
ActiveCell = cel & Chr(64 + nb)
ActiveCell.Offset(1, 0).Select
Next nb
Next cel
ActiveCell.Offset(-1, 0).Select
If ActiveCell.Column < x Then GoTo encore
laCol = ActiveCell.Column
laLg = ActiveCell.Row
For i = laLg To 1 Step -1
For j = 1 To Len(Cells(i, laCol))
Ltt$ = Mid(Cells(i, laCol), j, 1)
If Len(Application.Substitute(Cells(i, laCol), Ltt, "")) <>
Len(Cells(i, laCol)) - 1 Then
Cells(i, laCol).Delete
Exit For
End If
Next j
Next i
Range("B:" & Split(Cells(1, laCol - 1).Address, "$")(1)).Delete
End Sub
j'ai trois cellules ayant pour valeur A B C comment puis-je obtenir ce résultat
ABC ACB BAC BCA CAB CBA
En utilisant la feuille de calcul et pas de tableau en mémoire et à partir d'une feuille vide :
Sub Combine_Lettres() Range("A1").CurrentRegion.ClearContents x% = 3 'nombre de lettres (A,B,C,D....) à adapter ou initialiser avec InputBox Application.ScreenUpdating = False For nb% = 1 To x Cells(nb, 1) = Chr(64 + nb) Next Cells(x, 1).Select encore: Set plage = Range(Cells(1, ActiveCell.Column), ActiveCell) plage.Cells(1).Offset(0, 1).Select For Each cel In plage For nb = 1 To x ActiveCell = cel & Chr(64 + nb) ActiveCell.Offset(1, 0).Select Next nb Next cel ActiveCell.Offset(-1, 0).Select If ActiveCell.Column < x Then GoTo encore laCol = ActiveCell.Column laLg = ActiveCell.Row
For i = laLg To 1 Step -1 For j = 1 To Len(Cells(i, laCol)) Ltt$ = Mid(Cells(i, laCol), j, 1) If Len(Application.Substitute(Cells(i, laCol), Ltt, "")) <> Len(Cells(i, laCol)) - 1 Then Cells(i, laCol).Delete Exit For End If Next j Next i Range("B:" & Split(Cells(1, laCol - 1).Address, "$")(1)).Delete End Sub
http://cjoint.com/?jwswAUfzk6
Filochard
PS : Ne pas exécuter l'exemple à partir de c-joint mais le sauvegarder d'abord sur le DD par ex.
PS : Ne pas exécuter l'exemple à partir de c-joint mais le sauvegarder d'abord
sur le DD par ex.
