VBA : Extraire les 5 caractères suivant 8 tirets

cibleo

XLDnaute Impliqué
Bonjour le forum,

Le contenu de C1 est obtenu en exécutant une macro d'importation de MichelXLD (Voir dans le module standard).

Il s'agit du contenu d'une page Web.

De la cellule C1, j'aimerais donc extraire 3 données de 5 caractères (Prix du litre de gazole).

Or j'ai constaté que les 3 données figuraient à chaque fois à la suite de 8 tirets.

A partir d'une recherche des 8 tirets, n'y a t-il pas un moyen d'extraire ces 3 données et de les affecter successivement à D1, D2 et D3.

En D1, j'ai mis la formule ci-dessous : Voir le résultat pas vraiment probant en plus j'aimerais le réaliser en VBA.

=STXT(C1;TROUVE("--------";C1);13)

Pouvez-vous me venir en aide ?

Cibleo

Ps : Je précise que j'ai essayé les requêtes Web que ce soit manuellement ou par macro.

Résultat l'importation de la table concernée ne s'effectue pas par macro.

C'est pourquoi, je contourne le problème en utilisant la macro de MichelXLD qui me permet d'afficher le contenu de ma page Web en C1.
 

Pièces jointes

  • VersionFinalePlanning17.xls
    90 KB · Affichages: 107

Staple1600

XLDnaute Barbatruc
Re : VBA : Extraire les 5 caractères suivant 8 tirets

Bonjour


Pourquoi importer tout en C1 ?

Pourquoi ne pas splitter le contenu de C1 sur plusieurs lignes ?

un exemple possible

Code:
Sub splitter()
Dim t
t = Split([C1].Text, Chr(10))
[A1].Resize(UBound(t)) = Application.Transpose(t)
With Columns(1)
    .Replace Chr(13), vbNullString
    .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End With
End Sub

Ensuite tu pourras plus facilement utiliser tes formules non ?
 
Dernière édition:

cibleo

XLDnaute Impliqué
Re : VBA : Extraire les 5 caractères suivant 8 tirets

Bonjour Staple1600 :)

Pas mal, pas mal comme dirait l'autre :D

C'est exactement comme cela que je voulais d'abord importer la page Web pour pouvoir ensuite extraire les éléments souhaités.

Reste donc à extraire à partir des 3 cellules concernées les données à savoir le prix du gazole situé après les 8 tirets.

Ensuite, il faut que je soigne la présentation en effectuant une mise en forme générale dans ma feuille de calcul.

A+Cibleo
 

Staple1600

XLDnaute Barbatruc
Re : VBA : Extraire les 5 caractères suivant 8 tirets

Re


Une petite amélioration du code précédent

Code:
Sub splitterv2()
Dim t
t = Split([C1].Text, Chr(10))
[A1].Resize(UBound(t)) = Application.Transpose(t)
With Columns(1)
    .Replace Chr(13), vbNullString
    .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End With
Columns(3).Delete
Rows("1:16").Delete
Rows(65536).End(xlUp).Delete
End Sub
 

cibleo

XLDnaute Impliqué
Re : VBA : Extraire les 5 caractères suivant 8 tirets

Re à tous,

Avec ton complément ci-dessus, j'obtiens donc ceci en A1 Staple :

AuxerreINTERMARCHE AUXERREIntermarché--------1,12926/03/10----1,36911/03/10

J'aimerais maintenant obtenir en D1, 1,129 soit extraire les 5 caractères après les 8 tirets ceci par formule ou VBA et par conséquent éviter le menu > Données > Convertir

Je sais qu'il y a des champions des fonctions personnalisées sur ce forum.

Merci à tous

Je continue mes recherches.

A+ Cibleo
 

Staple1600

XLDnaute Barbatruc
Re : VBA : Extraire les 5 caractères suivant 8 tirets

Re


Pour te faire plaisir , solution avec formule

Code:
Sub splitterv3()
Dim t
t = Split([C1].Text, Chr(10))
[A1].Resize(UBound(t)) = Application.Transpose(t)
With Columns(1)
    .Replace Chr(13), vbNullString
    .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End With
Columns(3).Delete
Rows("1:16").Delete
Rows(65536).End(xlUp).Delete
With [B1].Resize([A65536].End(xlUp).Row)
    .FormulaR1C1 = "=MID(RC[-1],SEARCH("","",RC[-1])-1,5)*1"
    .Value = .Value
End With
End Sub
 

cibleo

XLDnaute Impliqué
Re : VBA : Extraire les 5 caractères suivant 8 tirets

Bonjour à tous,
Bonjour Staple, Eric :)

Pour résumer, dans le fichier du 1er post, figurait en C1 le contenu d'une page Web importée. (Un code de MichelXLD)

De cette page web, je cherchais à isoler 3 éléments représentant le prix du litre de gazole de 3 stations services.

Voici le résultat obtenu, dans l'illustration ci-dessous, avec le code de Staple1600.

Auchan.jpg

Code:
Sub splitterv3()
Dim t
t = Split([[COLOR=red]C1[/COLOR]].Text, Chr(10))
[A1].Resize(UBound(t)) = Application.Transpose(t)
With Columns(1)
    .Replace Chr(13), vbNullString
    .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End With
Columns(3).Delete
Rows("1:16").Delete
Rows(65536).End(xlUp).Delete
With [B1].Resize([A65536].End(xlUp).Row)
    .FormulaR1C1 = "=MID(RC[-1],SEARCH("","",RC[-1])-1,5)*1"
    .Value = .Value
End With
Range("A1").Value = "Intermarché Auxerre"
Range("A2").Value = "Auchan Avallon"
Range("A3").Value = "Guillemeau Avallon"
With Range("A1:B3")
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Characters.Font.Size = 11
    .Characters.Font.Name = "verdana"
End With
Range("B1:B3").NumberFormat = "# ##0.000 €"
Columns("A:B").AutoFit
End Sub

Fallait la trouver la formule d'extraction :cool:

Mille Mercis Staple

Maintenant, je continue sur ma lancée avec une autre petite macro.

Comment affecter dans une même variable, l'ensemble de ces 3 données concaténées de cette façon avec un retour à la ligne.

Intermarché Auxerre : 1,139€
Auchan Avallon : 1,142€
Guillemeau Avallon : 1,142€

Ces données figurent dans la plage (A1:B3)

Cette variable complètera le message d'un Mail.

Merci de votre aide
Cibleo
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : VBA : Extraire les 5 caractères suivant 8 tirets

Bonjour



Histoire d'honorer mes endives

je verrai la chose ainsi, pour la dernière partie de ton code

Code:
Sub pour_mes_endives()
Dim strs
strs = Split("Intermarché Auxerre/Auchan Avallon/Guillemeau Avallon", "/")
With Range("A1:B3")
.Item(1).Resize(3) = Application.Transpose(strs)
.HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter
    With .Font
    .Size = 11: .Name = "verdana"
    End With
.Offset(, 1).Resize(, 1).NumberFormat = "# ##0.000 €"
.Columns.AutoFit
End With
End Sub
Pour ta variable (voici la version j'ai du temps à perdre)

Code:
Sub ma_concatenation()
Dim t, ma_var$
t = [A1:B3]
ReDim Preserve t(1 To 3, 1 To 3)
ma_var = t(1, 1) & " : " & Format(t(1, 2), "# ##0.000 €") & Chr(10)
ma_var = ma_var & t(2, 1) & " : " & Format(t(2, 2), "# ##0.000 €") & Chr(10)
ma_var = ma_var & t(3, 1) & " : " & Format(t(3, 2), "# ##0.000 €")
MsgBox ma_var
End Sub
EDITION: Plus sobre ;)

Code:
Sub ma_concatenation_light()
Dim ma_var$
ma_var = [A1].Text & " : " & [B1].Text & Chr(10)
ma_var = ma_var & [A2].Text & " : " & [B2].Text & Chr(10)
ma_var = ma_var & [A3].Text & " : " & [B3].Text
MsgBox ma_var
End Sub
 
Dernière édition:

cibleo

XLDnaute Impliqué
Re : VBA : Extraire les 5 caractères suivant 8 tirets

Bonjour à tous,
Bonjour Staple1600 :)

Connaissant ton goût pour la perfection, je savais que tu repasserais revisiter le code.

Et pour te démontrer que je ne boxe pas dans la même catégorie que toi, voici ce que je m'apprêtais à poster quand j'ai découvert ta solution.

Code:
Sub CONCAT()
Dim ListeStations  As String
Dim Stations As String
Dim PrixGazole As String
  For I = 1 To 3
    Stations = Cells(I, 1)
    PrixGazole = Cells(I, 2)
    ListeStations = ListeStations & Cells(I, 1) & " : " & Cells(I, 2) & " € " & Chr(10) ' je l'ajoute à la liste
  Next I
 
    MsgBox ListeStations
End Sub

Evidemment, pour ceux qui en douteraient encore, j'opte pour la solution de Staple :D

J'adore cette fluidité dans l'écriture de ces macros.

Au plaisir Cibleo ;)

PS : pour compléter la macro pour_mes_endives, je me disais que ça serait bien de rajouter une instruction de tri croissant par rapport à la colonne B.

Cela me permettrait de visualiser du 1er coup d'oeil, la station la moins chère vu que cette liste n'est pas exhaustive.
 

Staple1600

XLDnaute Barbatruc
Re : VBA : Extraire les 5 caractères suivant 8 tirets

Re



Comme disait un humanoïde d'un autre siècle

Qu'importe le flacon, pourvu qu'on ait l'ivresse
C'est une devise de base que j'applique en VBA.

Après on peut si on le souhaite on peut ciseler le flacon. (histoire de gouts)

pour compléter la macro pour_mes_endives, je me disais que ça serait bien de rajouter une instruction de tri croissant par rapport à la colonne B.
Pour ce faire, je te conseille de faire la manip en laissant tourner l'enregistreur de macros et d'adapter ensuite le code VBA obtenu.
 
Dernière édition:

cibleo

XLDnaute Impliqué
Re : VBA : Extraire les 5 caractères suivant 8 tirets

Bonjour à tous,
Bonjour Staple1600,

La manip a été effectuée, c'est tout bon pour le tri.

Sinon pour l'affectation de la variable, j'ai testé les 2 versions en les intégrant dans une macro d'envoi de Mail et me suis aperçu que le symbole € n'était pas pris en compte.

Il est remplacé par un ?.

Voir l'illustration ci-dessous.

Je précise que je possède Vista et Windows Mail

Avez-vous déjà rencontré ce problème, cela provient-il de ma messagerie qu'il faut paramétrer.

Code:
.../...
With Sheets("ImportPrixGazole")
    Stations = .[A1].Text & " : " & .[B1].Text & Chr(10)
    Stations = Stations & .[A2].Text & " : " & .[B2].Text & Chr(10)
    Stations = Stations & .[A3].Text & " : " & .[B3].Text
    MsgBox Stations
End With
.../...

Code:
.../...
With Sheets("ImportPrixGazole") [COLOR=darkgreen]'Ici t est déclaré en Variant[/COLOR] (erreur : tableau attendu)
    t = .[A1:B3]
    ReDim Preserve t(1 To 3, 1 To 3)
    Stations = t(1, 1) & " : " & Format(t(1, 2), "# ##0.000 €") & Chr(10)
    Stations = Stations & t(2, 1) & " : " & Format(t(2, 2), "# ##0.000 €") & Chr(10)
    Stations = Stations & t(3, 1) & " : " & Format(t(3, 2), "# ##0.000 €")
    MsgBox Stations
End With
.../...

Code:
.../...
        Msg = Msg & "Pour Info, les prix du gazole relevé à " & Format(Now, "hh:mm") & vbCrLf
        Msg = Msg & [COLOR=red]Stations[/COLOR] & vbCrLf & vbCrLf
 
        Msg = Msg & "Cordialement Sylvie"
.../...

La réception du mail :

Mailoo.jpg

Cibleo

Ps : je précise bien, c'est dans le mail que cela cloche et non dans l'affectation de la variable.
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 724
Messages
2 081 937
Membres
101 844
dernier inscrit
pktla