Incrémentation de lettres et chiffres

Bonjour,

Je cherche à faire apparaître avec vba des formes avec un texte dedans.

La première forme contient A, la seconde forme : B...... la 26ème forme : Z, la 27ème forme: A1, A2 etc etc....

J'ai trouvé ce code mais je n'y comprends absolument rien

Sub lettre()

Dim i As Integer, j As Integer, x As Integer, s As Integer
Dim lettre As String
Dim tablo()

On Error Resume Next

Cells(1, 1).Value = UCase(Cells(1, 1).Value)

For i = 0 To 25
    lettre = Chr(i + 65)
    ReDim Preserve tablo(i)
    tablo(i) = lettre
Next

For j = 0 To 25
    For r = 0 To 25
        lettre = tablo(j) & tablo(r)
        x = UBound(tablo) + 1
        ReDim Preserve tablo(x)
        tablo(x) = lettre
    Next
Next

For s = 0 To UBound(tablo)
    If tablo(s) = Cells(1, 1).Value Then
        Cells(1, 1).Value = tablo(s + 1)
        Exit Sub
    End If
Next

End Sub

Edit :

Le code passe à AA au lieu de A1 après Z... pourriez vous me donner un coup de main svp

Bonjour,

c'est un code pour écrire des lettre en coloriant des cellules, non ?

@ bientôt

LouReeD

Bonjour LouReeD,

Non ici c'est un code qui va simplement incrémenter la cellule A1. Pas de coloriage.

Mon soucis c'est qu'après la lettre Z je n'arrive pas à lui faire écrire A1, B1, C1 etc. Le code est programmé pour écrire AA, AB, AC....

Et je ne comprends pas la logique du code... Je n'ai jamais utilisé les termes qui sont dedans

Bonsoir,

ci dessous le code "décodé" :

Option Explicit

Sub lettre()

Dim i As Integer, j As Integer, x As Integer, s As Integer, r As Integer
Dim lettre As String
Dim tablo()

On Error Resume Next

' mise en majuscule de la valeur de la cellule A1
Cells(1, 1).Value = UCase(Cells(1, 1).Value)

'remplissage du tableau "tablo" avec les 26 lettres majuscule de l'alphabet de A à Z = code ASCII de 65 à 90 inclus
For i = 0 To 25
    lettre = Chr(i + 65) ' on attribue à la variable lettre la lettre majuscule qui correspond au code ASCII n° 65 + i
    ReDim Preserve tablo(i) ' ici on redimensionne le tableau tablo d'une taille de i en gardant en mémoire les valeurs déjà inscrites
    tablo(i) = lettre ' on attribue à la "case" i du tableau tablo la lettre ci dessus déterminée
Next

' on continue de remplir le tableau au delà de Z, pour aller de AA à ZZ donc 26 boucle de 26 lettres
For j = 0 To 25 ' première boucle de A à Z
    For r = 0 To 25 ' deuxième boucle de A à Z
        lettre = tablo(j) & tablo(r) ' lettre au "premier tour de boucle" = AA, le deuxième tour, même valeur de j = A valeur de r + 1 = B etc...
        x = UBound(tablo) + 1 ' ici on détermine la "futur" taille du tableau final qui correspond à la taille du tableau tablo + 1
        ReDim Preserve tablo(x) ' on redimention en gardant ce qui existe déjà
        tablo(x) = lettre ' on inscrit dans cette "nouvelle case" la valeur de lettre qui au premier tour vaut AA
    Next
Next

' remplacement de la valeur de la cellule A1 avec la valeur suivante du tableau tablo
For s = 0 To UBound(tablo) ' on boucle sur toutes les valeurs du tableau tablo
    If tablo(s) = Cells(1, 1).Value Then ' si on trouve la valeur se trouvant dans la cellule A1
        Cells(1, 1).Value = tablo(s + 1) ' la cellule A1 prend la valeur suivante de celle trouvée dans le tableau tablo
        ' donc si A1 = "AC" alors A1= "AD"
        Exit Sub 'on sort de la SUB, sans finir la recherche car elle a été fructueuse
    End If
Next

End Sub

Maintenant vous comprenez mieux le principe de fonctionnement.

Ceci dit si de votre coté le numérique est "infini" après les 26 premières lettres, et que ça reste sur du A, le mieux est de codé différemment.

@ bientôt

LouReeD

Re bonsoir,

ci-joint un fichier test :

45test-compteur.xlsm (18.33 Ko)

@ bientôt

LouReeD

Super l'analyse !

Merci beaucoup d'avoir prit le temps de le faire c'est très gentil !

Par contre mon but n'est pas d'avoir une variable numérique infinie. Il est le suivant.

Une fois Z passé, on repart à A1 pour aller jusqu'à Z1.

Une fois Z1 passé, on repart à A2 pour aller jusqu'à Z2 etc...

A=> Z

A1 => Z1

A2 => Z2

A3 => Z3

A4 => Z4

Ce matin j'ai essayé de cette manière. Mais vu mon niveau encore faible, j'ai du oublier un truc parce que ma cellule passe directement à Z4

Sub inc()
Dim I, C As Long
    For C = 0 To 4
        For I = 0 To 25
            If C = 0 Then
               Worksheets("Plan-1").Range("BH4").Value = Chr$(Asc("A") + I)
            Else
               Worksheets("Plan-1").Range("BH4").Value = Chr$(Asc("A") + I) & C
            End If
          Next
    Next
End Sub

Bonjour,

voici le code modifié :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Nouv_Variable As String, Temp, Alpha
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        Application.EnableEvents = False
        If Len(Target.Value) = 1 Then
            If Asc(UCase(Target.Value)) > 89 Then
                Nouv_Variable = "A1"
            ElseIf Asc(UCase(Target.Value)) >= 65 Then
                Nouv_Variable = Chr(Asc(UCase(Target.Value)) + 1)
            Else
                Nouv_Variable = ""
            End If
            Range("A1").Value = Nouv_Variable
        Else
            Temp = Right(Target.Value, Len(Target.Value) - 1)
            Alpha = Asc(UCase(Left(Target.Value, 1)))
            Temp = CDbl(Temp) + 1
            If Temp > 26 Then
                Temp = 1
                Alpha = Alpha + 1
                If Alpha > 90 Then Alpha = 65
            End If
            Nouv_Variable = UCase(Chr(Alpha)) & Temp
            Range("A1").Value = Nouv_Variable
        End If
        Application.EnableEvents = True
    End If
End Sub

de A à Z, puis de A1 à A26, puis de B1 à B26 etc...

Si j'ai bien compris...

@ bientôt

LouReeD

Alors ce n'est pas tout a fait ça. Voici le détail de la suite que j'aimerai obtenir :

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 A1 B1 C1 D1 E1 F1 G1 H1 I1 J1 K1 L1 M1 N1 O1 P1 Q1 R1 S1 T1 U1 V1 W1 X1 Y1 Z1 A2 B2 C2 D2 E2 F2 G2 H2 I2 J2 K2 L2 M2 N2 O2 P2 Q2 R2 S2 T2 U2 V2 W2 X2 Y2 Z2 A3 B3 C3 D3 E3 F3 G3 H3 I3 J3 K3 L3 M3 N3 O3 P3 Q3 R3 S3 T3 U3 V3 W3 X3 Y3 Z3 A4 B4 C4 D4 E4 F4 G4 H4 I4 J4 K4 L4 M4 N4 O4 P4 Q4 R4 S4 T4 U4 V4 W4 X4 Y4 Z4.

Voici précisément l'ordre de l'incrémentation

Bonsoir,

re voici le code modifié, maintenant que j'ai compris....

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Nouv_Variable As String, Temp, Alpha
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        Application.EnableEvents = False
        If Len(Target.Value) = 1 Then
            If Asc(UCase(Target.Value)) > 89 Then
                Nouv_Variable = "A1"
            ElseIf Asc(UCase(Target.Value)) >= 65 Then
                Nouv_Variable = Chr(Asc(UCase(Target.Value)) + 1)
            Else
                Nouv_Variable = ""
            End If
            Range("A1").Value = Nouv_Variable
        Else
            Temp = Right(Target.Value, Len(Target.Value) - 1)
            Alpha = Asc(UCase(Left(Target.Value, 1)))
            Alpha = Alpha + 1
            If Alpha > 90 Then
                Alpha = 65
                Temp = CDbl(Temp) + 1
                If Temp > 4 Then
                    Temp = ""
                End If
            End If
            Nouv_Variable = UCase(Chr(Alpha)) & Temp
            Range("A1").Value = Nouv_Variable
        End If
        Application.EnableEvents = True
    End If
End Sub

après Z4, on repasse à A (enfin dans le code ça fait ça, peut être ne le faut il pas....)

@ bientôt

LouReeD

Bonjour LouReeD,

Petite question, comment le code se lance t-il...?

Bonjour TheHarryPop, LouReeD,

C'est la sub Worksheet_Change, donc elle se lance automatiquement si tu changes la valeur d'une cellule de la feuille.

Dans cet exercice précis, c'est uniquement si tu changes la valeur de la cellule A1 ; et le traitement sera différent selon que la longueur du texte de A1 est d'un seul caractère ou plus.

Le code VBA doit être placé dans le module de la feuille, pas dans un module habituel.

dhany

Bonjour dhany,

Merci pour la réponse !

Y a t-il un autre moyen de lancer cette macro ?

Parce que dans le fonctionnement de mon fichier, je vais me créer un bouton qui quand on clique dessus incrémentera cette cellule, et des objets prendront sa valeur.

Du coup je ne peux lancer cette macro avec un bouton...

Désolé mes bases VBA sont encore très fragiles !

@TheHarryPop

Je te propose ce fichier Excel :

19exo-thp.xlsm (18.15 Ko)

La cellule A1 contient la lettre A ; tu peux faire Ctrl i ou cliquer sur le bouton « Inc A1 » (au choix).

Alt F11 pour voir le code VBA, puis revenir sur Excel

dhany

Effectivement ça marche parfaitement là !

Seul souci je n'ai pas réussi à déplacer la cellule A1 en BH4 pour l'adapter à mon fichier

Je ne comprends pas la moitié de ton code. Je me demande comment vous arrivez à m'écrire des codes comme ça

Je te propose cette nouvelle version :

8exo-thp.xlsm (19.17 Ko)

La cellule incrémentée est BH4 ; si plus tard tu veux changer pour une autre cellule, tu verras dans le code VBA qu'il n'y a qu'une seule ligne à changer ; par exemple si tu veux incrémenter la cellule D5, remplace With [BH4] par With [D5] (en laissant les crochets !)

dhany

Bonsoir @ vous deux !

Je me demande comment vous arrivez à m'écrire des codes comme ça

En effet je n'en suis pas encore là, je suis très séquentiel et je ne vois pas la globalité des choses....

Contrairement à dhany et bien d'autre !

@ bientôt

LouReeD

Super !

Merci beaucoup à vous deux vous m'avez tiré une épine du pied comme on dit !

Ce n'est plus le sujet du post, mais à tous hasard y a t-il une méthode pour adapter la taille d'une shape (bulle) à la taille de la police qu'elle contient ?

Je pose cette question car quand je fais apparaître mes bulles avec les 26 premières lettres pas de soucis mais dès qu'on passe à A1, le format de la bulle n'est plus adapté et on ne voit que le "A"

Sub BULLE()

    PP = Sheets("Plan-1").Range("BH4").Value
    ActiveSheet.Shapes.AddShape(msoShapeOval, 875, 275, 30, 30).Select
    Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
    Selection.ShapeRange.Name = PP
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = PP
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1). _
        ParagraphFormat
        .FirstLineIndent = 0
        .Alignment = msoAlignCenter
    End With
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).Font
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 15
        .Name = "+mn-lt"
    End With
    With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 0
        .Solid
    End With
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 0
        .Weight = 2.25
    End With
    Selection.ShapeRange.Fill.Visible = msoFalse
    FindShape
    IncBH4

End Sub

Voici ce que j'ai "bidouillé"... (ne vous moquez pas, je ne suis pas spécialiste )

Bonsoir,

vous l'avez bien dit :

Ce n'est plus le sujet du post, mais à tous hasard y a t-il une méthode pour adapter la taille d'une shape (bulle) à la taille de la police qu'elle contient ?

Le mieux est d'ouvrir un nouveau fil...

@ bientôt

LouReeD

Bonsoir,

Oui justement c'est ce que j'ai fait 😉

Un membre vient justement de répondre en me proposant un fichier test. J'irai le voir demain quand je serai sur mon ordinateur.

Merci encore de l'aide !

Désolé,

j'ai du retard dans les réponses...

@ bientôt

LouReeD

Rechercher des sujets similaires à "incrementation lettres chiffres"