Discussion :

[philppe27]

Bonjour,

J'ai besoin d'aide pour le problème suivant :

J'ai dans une cellule dans une même colonne des suites de caractères du type:
15 ghd-dfg rty 16
19 ghx-dfgv-d16 rty 16
hjk-dfg 45 mlk
ert ghz-uiop 16 jui cvb-nhj

Je voudrais ne conserver dans le même ordre que :
ghd-dfg
ghx-dfgv-d16
hjk-dfg
ghz-uiop cvb-nhj
donc ne conservez que les mots (entre 2 espaces) qui contiennent le caractère "-"
dans le dernier cas puisqu'il y a 2 mots qui contiennent "-" je souhaiterais qu'ils soient dans 2 cellules différentes sur la même ligne (il n'y a au maximum que 2 mots contenants le caractère "-" dans 1 cellule)

Quelle(s) formule(s) me permettrait de d'obtenir ce résultat ?

Merci d'avance

[casefayere]

Bonjour,
une idée à améliorer car pour l'instant toutes les occurences se retrouvent les unes en dessous de autres :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Option Base 1
Sub chaine()
Dim dl As Long, ch, x As Long, tb1, tb2(), z As Long, y As Long
dl = Range("C" & Rows.Count).End(xlUp).Row
tb1 = Range("C3:C" & dl)
For x = 1 To UBound(tb1)
  ch = Split(tb1(x, 1))
  For y = 0 To UBound(ch)
    If ch(y) Like "*-*" Then
      z = z + 1
      ReDim Preserve tb2(1 To z)
      tb2(z) = ch(y)
    End If
  Next y
Next x
Range("D3:D" & z + 2) = WorksheetFunction.Transpose(tb2)
 
End Sub

[philppe27]

merci je dois pouvoir m'en sortir avec cela

[casefayere]

Une autre proposition qui devrait correspondre à ta demande

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Option Base 1
Sub chaine()
Dim dl As Long, ch, x As Long, tb1, tb2(), tb3(), z As Long, y As Long, a As Integer
dl = Range("C" & Rows.Count).End(xlUp).Row
tb1 = Range("C3:C" & dl)
For x = 1 To UBound(tb1)
  ch = Split(tb1(x, 1))
  For y = 0 To UBound(ch)
    If ch(y) Like "*-*" Then
      z = z + 1
      ReDim Preserve tb2(1 To z)
      tb2(z) = ch(y)
      Exit For
    End If
  Next y
  If UBound(ch) > y Then
    On Error Resume Next
    For a = y + 1 To UBound(ch)
      If ch(a) Like "*-*" Then
        If Err = 0 Then
          ReDim Preserve tb3(1 To z)
          tb3(z) = ch(a)
          Err.Clear
          Exit For
        End If
      End If
    Next a
  End If
Next x
Range("D3:D" & z + 1) = WorksheetFunction.Transpose(tb2)
Range("E3:E" & z + 1) = WorksheetFunction.Transpose(tb3)
End Sub

penses à cliquer sur si tu crois en avoir terminé avec ta demande

Bonne fin de journée