XL 2016 Mise en forme d'un fichier Excel, création onglets

wDog66 à dit:

Pourquoi ne pas demander à chatGPT pour ce genre de chose

Cliquez pour agrandir...

sylvanu à dit:

Bonjour Ninieg, wDog,

Encore faut il que ChatGPT puisse répondre sans erreur, ce qui en VBA est rarement le cas.
Ensuite, répondre à des problèmes XL, c'est l'essence même d' XLD.

@ninieg
Le problème sera d'identifier la page à créer.
Par ex pour MP / AC / 42CD4T / ROND : ROND on prend 42CD4T soit l'avant dernière chaine.
Mais quand vous avez :
MP / AC / C45 : C45 : Vous prenez AC ? Ce qui m'étonnerait
car vous avez ensuite : MP / AC / C45 / Plat : Plat qui correspondrait à C45.

En PJ j'ai mis en colonne O toutes les chaines en italique de la colonne A.
J'ai mis en rouge quelques appellations dont je ne comprends pas quelle feuille il faudrait créer.
Un peu d'éclaircissements seraient les bienvenus.

Cliquez pour agrandir...

wDog66 à dit:

Bonjour ninieg,

Pourquoi ne pas demander à chatGPT pour ce genre de chose

Cliquez pour agrandir...

wDog66 à dit:

Bien souvent, si ChatGPT ne répond pas correctement, c'est que la demande n'est pas assez explicite

Cliquez pour agrandir...

sylvanu à dit:

Par ex ici sans la précision du post #4 même un humain ne pourrait résoudre le problème.

Cliquez pour agrandir...

wDog66 à dit:

Il est navrant de voir que vous semblez si allergique l'IA générative... il faut savoir vivre avec son temps

Cliquez pour agrandir...

Ecrire un programme en VBA Excel pour remplir les cellules de A1 à A20 avec "Essai"

Cliquez pour agrandir...

Sub RemplirCellules()
    Dim i As Integer
    For i = 1 To 20
        Cells(i, 1).Value = "Essai"
    Next i
End Sub

Sub Test()
    [A1:A20]="Essai"
End Sub

sylvanu à dit:

Re,
Un essai en PJ avec ces macros :

VB:

Public ListeFeuilles, Factive
Sub ConstruireFichier()
Dim L%
Set Factive = ActiveSheet
Application.StatusBar = "Suppression des feuilles.": SupprimerFeuilles
Application.StatusBar = "Faire la Liste des Feuilles.": FaireListeFeuilles
Application.ScreenUpdating = False
For L = 1 To UBound(ListeFeuilles)
    If ListeFeuilles(L, 1) = "" Then Exit For
    CreerRemplirFeuilles (L)
Next L
Application.StatusBar = ""
End Sub
Sub CreerRemplirFeuilles(L)
'Créer une feuille, la renomme, la remplit
On Error GoTo FinCréer
Dim Nom$, Début%, Fin%, Taille%
Nom = ListeFeuilles(L, 1)
Début = ListeFeuilles(L, 2)
Fin = ListeFeuilles(L + 1, 2)
Taille = Fin - Début
Application.StatusBar = "Création de la feuille " & Nom
Sheets.Add After:=Sheets(Sheets.Count): ActiveSheet.Name = Nom
With Sheets(Nom)
    Range(.Cells(1, "A"), .Cells(Taille, "J")) = Range(Factive.Cells(Début, "A"), Factive.Cells(Fin, "J")).Value
    .Columns.AutoFit
End With
Factive.Select
FinCréer:
End Sub
Sub SupprimerFeuilles()
'Supprime toutes les feuilles sauf celle active.
Dim F
Application.DisplayAlerts = False
For Each F In Worksheets
    If F.Name <> Factive.Name Then Sheets(F.Name).Delete
Next F
Application.DisplayAlerts = True
End Sub
Sub FaireListeFeuilles()
Dim Ligne%, L%
'Fait la liste de tous les noms de feuilles à créer
ReDim ListeFeuilles(1 To 1000, 1 To 2)
Ligne = 1
With ActiveSheet
    For L = 1 To .[A60000].End(xlUp).Row
        If Cells(L, "A").Font.Italic = True And Cells(L, "A").Font.Bold = True Then ' Si cellule gras/italique
            Nom = ConstruireNom(.Cells(L, "A"))
            If Nom <> "" Then
                ListeFeuilles(Ligne, 1) = Nom   ' Nom de la feuille à créer
                ListeFeuilles(Ligne, 2) = L     ' Numéro de la 1ere ligne à sauvegarder
                Ligne = Ligne + 1
            End If
        End If
    Next L
    ListeFeuilles(Ligne, 2) = L                 ' Dernière ligne à sauvegarder pour la dernière feuilles
End With
End Sub
Function ConstruireNom(Nom)
Dim T, Fin%
ConstruireNom = ""
T = Split(Nom, "/"): Fin = UBound(T)
If T(Fin) <> "" Then
    If Fin = 1 Then
        ConstruireNom = T(Fin - 1) & "-" & Split(T(Fin), ":")(1)
    Else
        ConstruireNom = T(Fin - 2) & "-" & T(Fin - 1) & "-" & Split(T(Fin), ":")(1)
    End If
    ConstruireNom = Replace(ConstruireNom, "  ", " ")
    ConstruireNom = Trim(ConstruireNom)
    If Len(ConstruireNom) > 31 Then ConstruireNom = Mid(ConstruireNom, 1, 31)
End If
End Function

Cliquez pour agrandir...

sylvanu à dit:

Re,
Mais est ce que le résultat est celui attendu ?

Cliquez pour agrandir...