Séparer les mots des cellules

Bonjour,

Le souci est qu'on ne sait pas d'où sont extraites les valeurs de la colonne D.

à partir de ces données brutes, modifier les intitulés colonne A en conséquence, entrer les formules des colonnes E2 à E8, sélectionner ce bloc de 7 cellules et le copier autant de fois que nécessaire vers le bas.

https://cijoint.org/r/MBbCBfFb#VHSvNLBTo1DHOEwELntqIjQ4zPHifnksnCxyxBTDTaA=

Bonjour
Les valeurs de la colonne D sont extraites du site suivant:
Heures des marées
il faut mettre la page du site la plus petite possible.
Je sélectionne de Lundi 1 à 69 du Mardi 30.
Je copie et je mets ça dans la cellule D1
 

Bonjour,

Avec excel 2024 ou Excel 365, une seule formule :

=EXCLURE(REDUCE("";SIERREUR(SUBSTITUE(TEXTE.AVANT(D2:D205;" ";3);"Marée ";"");D2:D205);LAMBDA(x;y;SI(OU(NBCAR(y)<>NBCAR(SUBSTITUE(y;"basse";""));NBCAR(y)<>NBCAR(SUBSTITUE(y;"haute";"")));ASSEMB.V(x;NOMPROPRE(FRACTIONNER.TEXTE(y;;" ")));ASSEMB.V(x;y))));1)

Daniel 

je mets cette formule dans quelle cellule ?
J'ai Excel 2019.

Sinon, j'ai cette macro pour 1 jour (macro de novice)

Sub Marées()
'
' Marées Macro
'

'
    Range("H1").Select
    Selection.Copy
    Range("L1").Select
    ActiveSheet.Paste
    Range("H2").Select
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("H2"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(5, 1), Array(11, 1), Array(17, 1)), _
        TrailingMinusNumbers:=True
    Range("H3").Select
    Selection.TextToColumns Destination:=Range("H3"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(5, 1), Array(11, 1), Array(17, 1)), _
        TrailingMinusNumbers:=True
    Range("I2:K2").Select
    Selection.Copy
    Range("L2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("I3:K3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("L5").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("H4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("L8").Select
    ActiveSheet.Paste
    Range("H5").Select
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("H5"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(5, 1), Array(11, 1), Array(17, 1)), _
        TrailingMinusNumbers:=True
    Range("H6").Select
    Selection.TextToColumns Destination:=Range("H6"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(5, 1), Array(11, 1), Array(17, 1)), _
        TrailingMinusNumbers:=True
    Range("I5:K5").Select
    Selection.Copy
    Range("L9").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("I6:K6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("L12").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("H7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("L15").Select
    ActiveSheet.Paste
End Sub

Ca ne fonctionnera pas avec Excel 2019. Une solution par macro ?

Daniel

Essaie celle-ci (résultat à partir de I3) :

Sub test()
  Dim Tbl(), C As Range, I As Long, Tabl
  I = -1
  For Each C In Range("D2", Cells(Rows.Count, 4).End(xlUp))
    If IsNumeric(Right(C, 1)) Then
      I = I + 1
      ReDim Preserve Tbl(I)
      Tbl(I) = C
    Else
      Tabl = Split(C, " ")
      I = I + 1
      ReDim Preserve Tbl(I)
      Tbl(I) = Application.Proper(Tabl(1))
      I = I + 1
      ReDim Preserve Tbl(I)
      Tbl(I) = Tabl(2)
    End If
  Next C
  Range("I3").Resize(UBound(Tbl)) = Application.Transpose(Tbl)
End Sub

Daniel

Bonjour,
Ça m'a l'air bien ...je test

J'ai testé...impeccable...mais....

Pour mettre la macro dans mon fichier
il faut que le résultat soit en S5 à place de I3 (ça fonctionne)
Mettre la liste de départ en T5 au lieu de D2, et là, ça ne fonctionne plus.
Que faut-il modifier ?

Merci
Impeccable !!!!!
J'aurais pu aller plus loin, je n'ai pas vu de "T" ailleurs.
Je n'ai pas fait le rapprochement que le chiffre 4 correspondait à la colonne "T".
Merci encore

Bonjour Daniel
Pas de problème, ça fonctionne, mais.....
J'ai oublié 4 mots dans le résultat que je voulais. :-((
J'ai essayé de voir la macro pas à pas, mais ça ne fonctionne pas, je ne vois rien bouger.
Je t'envoie un nouveau fichier (j'espère que ça va être possible de modifier ?)

MaréesTest-7Juin

Bonjour,

Essaie :

Sub test()
  Dim Tbl(), C As Range, I As Long, Tabl
  I = -1
  For Each C In Range("T5", Cells(Rows.Count, "T").End(xlUp))
    If IsNumeric(Right(C, 1)) Then
      I = I + 1
      ReDim Preserve Tbl(I)
      Tbl(I) = C
    Else
      Tabl = Split(C, " ")
      I = I + 1
      ReDim Preserve Tbl(I)
      Tbl(I) = Application.Proper(Tabl(1))
      I = I + 1
      ReDim Preserve Tbl(I)
      Tbl(I) = Tabl(2)
      I = I + 1
      ReDim Preserve Tbl(I)
      Tbl(I) = Tabl(3)
    End If
  Next C
  Range("S5").Resize(UBound(Tbl)) = Application.Transpose(Tbl)
End Sub

Daniel

Bonjour,
Impeccable !!!
Pourtant j'ai tout essayé, à chaque fois j'avais des espaces....
Questions: Peux tu m'expliquer la macro ?

Dim Tbl(), C As Range, I As Long, Tabl

Voici la macro commentée :

Sub test()
  Dim Tbl(), C As Range, I As Long, Tabl
  I = -1
  'Boucle sur les cellules de la colonne T
  For Each C In Range("T5", Cells(Rows.Count, "T").End(xlUp))
    'si la position de droite est numérique
    '(cas de la date ou du coefficient de marée)
    If IsNumeric(Right(C, 1)) Then
      'ajout du contenu de la cellule dans la table
      I = I + 1
      ReDim Preserve Tbl(I)
      Tbl(I) = C
    Else
      'sinon, on découpe le contenu de la cellule là où il y a un  espace
      'on ajoute une à une les parties obtenues sauf la première (tbl(0) = "Marée")
      Tabl = Split(C, " ")
      I = I + 1
      ReDim Preserve Tbl(I)
      Tbl(I) = Application.Proper(Tabl(1))
      I = I + 1
      ReDim Preserve Tbl(I)
      Tbl(I) = Tabl(2)
      I = I + 1
      ReDim Preserve Tbl(I)
      Tbl(I) = Tabl(3)
    End If
  Next C
  'Ecriture de la table sur la feuille
  'le fait d'utiliser une table plutôt que d'écrire directement sur la feuille
  'fait gagner du temps
  Range("S5").Resize(UBound(Tbl)) = Application.Transpose(Tbl)
End Sub

La macro se base sur l'utilisation de la commande "Split" pour découper le contenu de la cellule en plusieurs segments :

La ligne :

Tabl = Split("Marée basse 00h00 1.72m", " ")

donne :

Daniel

impeccable !!!
Merci beaucoup de ta patience

Bonjour,

Peux-tu partager le fichier de juillet ?

Daniel