Extraire une chaîne de caractère variable VBA

Bonjour à tous,

J'ai une question qui peut paraître bête mais je n'arrive pas à extraire une chaîne de caractère variable.

C:\Documents\TEST\Semaine 01 - 2021

Ce que j'aimerais c'est juste pouvoir extraire le "1", le problème est que je dois faire ça pour les autres semaine aussi donc pour "Semaine 50" il me faut le "50" ainsi de suite.

Il y a un espace avant le "01" et après.

Merci d'avance.

Bonjour à toutes et tous !

Une proposition :

=CNUM(STXT(A1;TROUVE("Semaine";A1)+8;2))

Bonjour JFL et merci d'avoir répondu,

J'ai oublié de préciser que c'est pour une macro.

Merci d'avance.

Zalee a écrit :

J'ai oublié de préciser que c'est pour une macro.

La précision est d'importance.....

Les spécialistes es VBA ne manqueront pas d'apporter réponse.

Merci quand même JFL.

Bonjour !

Une possibilité :

NoSem = Int(Mid(Chaine, Len(Chaine) - 8, 2))

Pour info :
- Int(Nombre) revoie la partie entière d'un nombre (ici, je l'utilise pour convertir le texte "01" en nombre 1)
- Mid(Chaine, p, n) est l'équivalent VBA de la fonction Excel STXT, et permet de renvoyer n caractères d'une chaine en partant de la position p
- Len(Chaine) est l'équivalent VBA de la fonction Excel NBCAR, qui donne la longueur d'une chaine de caractères

Pour procéder autrement, tu peux aussi utiliser la fonction Split(Chaine, Sép) qui découpe une chaine de caractères selon un séparateur (un caractère unique ou une chaine). Le résultat est stocké dans une variable tableau. Exemple :

VarTab = Split("01/02/2021", "/")

Ce qui donne par exemple pour ton cas :

NoSem = Int(Split(Split(Chaine, "Semaine ")(1), " - ")(0))

Bonjour Pedro,

Toujours présent pour aider j'ai l'impression.

Bien évidemment la formule fonctionne parfaitement.

Un énorme merci pour les formules et pour la pédagogie.

Merci de ton retour, et content de constater que ça fonctionne (ce qui n'est pas toujours le cas, je te rassure, je suis tête en l'air !).

A+

Comme quoi avoir la tête en l'air n'empêche pas de réussir :)

J'aimerais juste te demander un dernier petit truc.

J'avais besoin de nommer ces fichiers car je vais devoir extraire encore une fois pour pouvoir obtenir seulement le "S" et le numéro de la semaine.

Ce que j'aimerais mettre en place c'est que :

-la dernière ligne vide soit détectée. Sur cette ligne se référer à la semaine vide qui est dans la colonne A, que la macro aille vérifier si le fichier est existant dans mon dossier "C:\Users\Documents\Suivi HMO\CONDI\".

-Si le fichier existe alors copier la dernière ligne non vide à la ligne en-dessous,

-si le fichier n'existe pas ne rien faire

Je sais pas si je suis claire dans mes explications. D'ailleurs ne pas du tout se fier au code ci-dessous parce que je pense que c'est totalement faux.

Merci d'avance :)

Sub Test()

Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim SF As Object 'déclare la variable SF (Système de Fichiers)
Dim D As Object 'déclare la variable D (Dossiers)
Dim EF As Object 'déclare la variable EF (Ensemble des Fichiers)
Dim F As Object 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable CD (Onglet Source)
Dim DEST As Range 'déclare la variable CD (Classeur Destination)

Set CD = ThisWorkbook
CH = "C:\Users\Documents\Suivi HMO\CONDI\"
Set OD = CD.Worksheets("Mensuel")
Set SF = CreateObject("Scripting.FileSystemObject")
Set D = SF.GETFolder(CH)
Set EF = D.Files

'For Each F In EF

        ThisWorkbook.Activate
        Worksheets("Mensuel").Activate
        DL = Range("B" & Rows.Count).End(xlUp).Row
        DLA = Range("B" & Rows.Count).End(xlUp).Row + 1
        DLS = Range("A" & DLA)
        DLSD = CA & "HMO" & " " & DLS & ".xlsx"

        If Dir(DLSD) = F Then
        ThisWorkbook.Worksheets("Mensuel").Range("B" & DL & ":DK" & DL).Copy
        ThisWorkbook.Worksheets("Mensuel").Range("B" & DLA & ":DK" & DLA).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        LigS = Range("A" & DL).Value
        LigA = Range("A" & DLA).Value
        Range("B" & DLA & ":DK" & DLA).Select
        Selection.Replace What:=LigS, Replacement:=LigA

   End If

    'Next F

End Sub

Je ne te cache pas qu'en première lecture, je n'ai pas tout compris !

Je regarde ça à tête reposée et je reviens vers toi plus tard. Peut être qu'un contributeur mieux réveillé que moi sera passé entre temps...

Bonjour Zalee,

J'ai relu ton message, mais c'est encore beaucoup trop abstrait pour moi. Je te propose de :
- Créer un nouveau sujet dédié à cette demande
- Reprendre tes explications sous forme de texte, en y apportant un maximum de détails
- Inclure des fichiers de démo anonymisés (ton fichier destiné à contenir la macro + 1 ou 2 fichiers semaine en soulignant bien les informations que tu cherches à rapatrier depuis ces fichiers et les endroits où les placer dans le fichier de destination)

En attendant, je vais considérer que toi tu as compris ton besoin et que ton code à juste besoin de quelques corrections sur la forme...

Un essai, en espérant avoir compris quelque chose !

Sub Test()

Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim F As String 'déclare la variable F (Nom fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim DL As Long 'déclare la variable DL (dernière ligne classeur source)
Dim DLA As Long 'déclare la variable DLA (dernière ligne classeur de destination)

CH = "C:\Users\Documents\Suivi HMO\CONDI\"
F = Dir(CH & "*.*")
Set OD = ThisWorkbook.Sheets("Mensuel")

Do While F <> "" 'Boucle sur les fichiers
    DLA = OD.Range("B" & Rows.Count).End(xlUp).Row + 1 '1ère ligne vierge du fichier de destination
    Set CS = Workbooks.Open(CH & F) 'Ouverture du fichier à importer
    With CS.Sheets(1)
        DL = .Range("B" & Rows.Count).End(xlUp).Row 'Dernière ligne complétée du fichier source
        .Range("B" & DL & ":DK" & DL).Copy OD.Range("B" & DLA & ":DK" & DLA) 'Copier cette ligne et la coller à la suite dans l'onglet de destination
        OD.Range("B" & DLA & ":DK" & DLA).Replace What:=.Range("A" & DL), Replacement:=OD.Range("A" & DLA) 'Remplacement de truc par machin
    End With
    CS.Close False 'Fermeture du fichier source sans enregistrer
    F = Dir() 'Passage au fichier suivant
Loop

End Sub

Tu n'as pas besoin de déclarer des montagnes de variables, surtout si tu ne les utilisent qu'une seule fois. Tu avais aussi des doublons dans ton code initial (DLS et LigA par exemple).

Bonjour Pedro,

Je suis navré je n'ai pas pu te répondre depuis hier j'étais très occupé.

Effectivement j'aurais du créer un nouveau sujet mais comme c'est un truc tout bête je ne voulais pas encombrer le forum avec ça.

Je te remercie pour ton code déjà il est beaucoup plus claire que l'ancien mais je doute que ce soit adapté. Simplement pour résumé (je pense qu'à partir de ce que tu m'as fourni je pourrais m'en sortir), ce que je voulais ce n'est pas recopier la dernière ligne d'un classeur source.

"=SIERREUR('C:\Users\Documents\Suivi HMO\CONDI\[HMO S1.xlsx]Sem'!$AS$12; 0"

Voilà la composition de mes cellules. Comme tu peux le constater il y a une liaison avec le classeur [HMO S1]. Ce que je voudrais c'est en gros une sorte de mise à jour.

En fait, ce que je fais une fois que je dispose d'un classeur HMO S* c'est que je vais dans mon classeur destination, ensuite je copie colle la dernière ligne non vide en dessous et ensuite je remplace "HMO S1" par "HMO S2" et ainsi de suite sur 53 semaines. En effet c'est long et chiant.

J'aimerais juste automatisé un remplacement je n'ai donc rien à importer du classeur source, simplement vérifier s'il existe.

Je te remercie tout de même je pense qu'à partir de ce que tu m'as donné j'arriverais à le faire sinon je créerais un nouveau sujet.

Ok c'est plus clair, je te laisse essayer et revenir ici si tu as des difficultés.

Bonjour Pedro,

Désolé de te déranger à nouveau mais j'ai juste besoin d'un petit coup de pouce.

Sub Dssai()

Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)

CH = "C:\Users\Documents\Suivi HMO\CONDI\2021\Semaines\"
Set OD = ThisWorkbook.Sheets("Mensuel")

        DL = Range("B" & Rows.Count).End(xlUp).Row ' der ligne non vide
        DLA = Range("B" & Rows.Count).End(xlUp).Row + 1 ' der ligne vide
        DLS = "HMO" & " " & Range("A" & DLA) & ".xlsm"

        Do While Dir(CH & "*.xls*", vbNormal) <> ""
            OD.Range("B" & DL & ":DK" & DL).Copy OD.Range("B" & DLA & ":DK" & DLA)
            Application.CutCopyMode = False
            LigS = "HMO" & " " & Range("A" & DL).Value
            Range("B" & DLA & ":DK" & DLA).Replace LigS, DLS
        Loop

End Sub

Le code fonctionne très bien le seul problème c'est au niveau de la boucle loop, mon programme part dans une boucle infinie.

Comment puis je boucler sur seulement les fichiers qui existe ?

Merci d'avance.

Bonjour,

La boucle utilisant Dir() sert à balayer des fichiers, et doit se terminer par Dir() pour passer au suivant.

PS :

DLA est inutile, dans la mesure ou DLA = DL + 1

Certaines variables ne sont pas déclarées (DL, DLA, DLS et LigS)

La feuille utilisée pour définir DL et DLA n'étant pas précisée, il s'agit par défaut de la feuille active

Sub Essai()

Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim F As String 'déclare la variable F (Fichier)

CH = "C:\Users\Documents\Suivi HMO\CONDI\2021\Semaines\"
Set OD = ThisWorkbook.Sheets("Mensuel")

        Do While Dir(CH & DLS & ".xlsm", vbNormal) <> ""
        DL = Range("B" & Rows.Count).End(xlUp).Row ' der ligne non vide
        DLS = "HMO" & " " & Range("A" & DL + 1) 'nom de la semaine de la dernière ligne non vide
        OD.Range("B" & DL & ":DK" & DL).Copy OD.Range("B" & DL + 1 & ":DK" & DL + 1)
        Application.CutCopyMode = False

        LigS = "HMO" & " " & Range("A" & DL).Value 'nom du fichier de l'avant dernière ligne
        Range("B" & DLA & ":DK" & DLA).Replace LigS, DLS 'remplacement du fichier de l'avant dernière ligne par le fichier de la dernière ligne
        Loop
End Sub

Merci beaucoup pour ta réponse. Voilà la modification qui marche parfaitement qui boucle aussi sur les fichiers existants. Seul soucis, arrivé à la dernière ligne ou il n'y a pas de fichier, ici j'ai jusque la semaine 17 donc pas de 18, il me colle la ligne de la semaine 17 sur la 18 et une fenêtre s'ouvre pour que je puisse trouver le fichier dans mes dossiers, je dois donc appuyer sur la touche echap pendant une minute le temps que j'annule toutes les cellules. Je n'arrive pas à éviter cette dernière ligne.

"Certaines variables ne sont pas déclarées (DL, DLA, DLS et LigS)" Pourtant ça marche sans, dois-je quand même les déclarer ?

"La feuille utilisée pour définir DL et DLA n'étant pas précisée, il s'agit par défaut de la feuille active" de même, une modification doit être apporté ?

Je te remercie d'avance.

Pour ta première question, je ne sais pas trop, je ne suis pas très familier de ce genre de procédure. Tu peux essayer différentes boucles :

'On entre dans la boucle tant que la condition est vérifiée (ton code actuel)
Do While Condition
    'Blabla
Loop
'On entre une fois dans la boucle et on ne recommence que si la condition est vérifiée
Do 
    'Blabla
Loop While Condition

Pour les 2 suivantes concernant mes remarques, non la déclaration des variables n'est pas obligatoire, mais fortement recommandée (d'autant plus que tu en déclare certaines et pas d'autres). Une variable non type sera pas défaut du type Variant, qui occupe plus de place en mémoire que la plupart des variables de type prédéfini.

Idem pour la feuille concernée par tes Range, pas d'obligation mais je recommande de préciser systématiquement la feuille pour éviter les mauvaises surprises (surtout si ton code se balade entre plusieurs feuilles/fichiers) et aussi pour mieux t'y retrouver en reprenant ton code plus tard.

Sub Essai()

Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim F As String 'déclare la variable F (Fichier)
Dim DL, DLS, LigS As String

CH = "C:\Users\Documents\Suivi HMO\CONDI\2021\Semaines\"
Set OD = ThisWorkbook.Sheets("Mensuel")

        DL = Range("B" & Rows.Count).End(xlUp).Row ' der ligne non vide
        DLS = "HMO" & " " & Range("A" & DL + 1) 'nom de la semaine de la dernière ligne non vide

        If Dir(CH & DLS & ".xlsm", vbNormal) <> "" then
        OD.Range("B" & DL & ":DK" & DL).Copy OD.Range("B" & DL + 1 & ":DK" & DL + 1)
        Application.CutCopyMode = False
        LigS = "HMO" & " " & Range("A" & DL).Value 'nom du fichier de l'avant dernière ligne
        OD.Range("B" & DL + 1 & ":DK" & DL + 1).Replace LigS, DLS 'remplacement du fichier de l'avant dernière ligne par le fichier de la dernière ligne
        End if 
End Sub

Merci pour tes réponses. Malheureusement rien y fait j'ai essayé les deux manières de boucler et ça ne donne la même chose. Le seul truc qui marche c'est ce code. Le problème c'est que je dois le faire en manuel. En effet à la main y a aucun soucis et la dernière ligne qui n'existe pas ne se met pas je ne comprends pas pourquoi mais malheureusement je n'arrive pas à faire de boucle.

En tout cas merci je vais me contenter de ça, c'est déjà pas mal :)