Discussion :

[gdroleteco]

Bonjour,

J'ai vraiment besoin d'aide. Cela fait 3 jours que je bûche sur un simple problème.
Je dois faire du code qui fera des manipulations sur des string.

Dans excel, j'ai une ligne qui contient:

46 (47, 48, 49, 50, 51), Logeron

Je dois arriver à, sur plusieurs lignes:

46, Logeron
47, Logeron
48, Logeron
49, Logeron
50, Logeron
51, Logeron.

Les lignes doivent se créer automatiquement en dessous de la première.

J'ai bidouiller avec un paquet de fonction, j'y suit presque mais il me manque de temps.

Merci de votre aide.

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
 
Sub manipul()
Dim sStr As String
Dim pos As Long
Dim rcol As Range
Dim rcell As Range
Dim x As Variant
Dim nobat As String
Dim adresse As String
Dim muni As String
Dim codepostal As String
Dim pospar As Long
Dim y As Variant
 
Set rcol = Range("b1343", "b1350")
 
For Each rcell In rcol
    pos = InStr(1, rcell, "(", vbTextCompare)
 
    'Si j'ai trouvé la (
    If pos <> 0 Then
        rcell.Select
        nobat = Range("A" & rcell.Row)
        muni = Range("C" & rcell.Row)
        codepostal = Range("D" & rcell.Row)
        x = Split(rcell, "(")
 
        'Ajout des lignes
        For i = 0 To (UBound(x)) - 1
 
            ActiveCell.Offset(1).EntireRow.Insert
 
            Range("A" & (rcell.Row + 1)).Value = nobat
 
 
            'Paranthese de gauche
            pospar = InStr(1, x(i), "(", vbTextCompare)
 
            If pospar <> 0 Then
                Range("B" & (rcell.Row + 1)).Value = Left(x(i), pospar - 1)
            Else
 
                pospar = (InStr(1, x(i), ")", vbTextCompare))
 
                'Paranthese de droite
                If pospar <> 0 Then
                    Range("B" & (rcell.Row + 1)).Value = Right(x(i), pospar - 1)
                Else
                    y = Split(Range("B" & (rcell.Row + 1)).Value = x(i + 1), ",")
                End If
            End If
 
            'Range("B" & (rcell.Row + 1)).Value = Left(x(i), InStrRev(x(i), "(", , vbTextCompare) - 1)
            Range("C" & (rcell.Row + 1)).Value = muni
            Range("D" & (rcell.Row + 1)).Value = codepostal
 
        Next i
 
    End If
 
Next
 
 
End Sub

[mercatog]

Une proposition selon ton explication

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
Dim LastLig As Long, i As Long
Dim j As Byte
Dim Str As String
Dim Tb
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")                               ' à adapter
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = LastLig To 2 Step -1
        Str = .Range("A" & i).Value
        Str = Replace(Str, " (", ", ")
        Str = Replace(Str, ")", "")
        Tb = Split(Str, ",")
        If UBound(Tb) > 1 Then
            .Rows(i).Copy
            .Rows(i & ":" & i + UBound(Tb) - 2).Insert
            Application.CutCopyMode = False
            For j = 0 To UBound(Tb) - 1
                .Range("A" & i + j).Value = Trim(Tb(j)) & ", " & Tb(UBound(Tb))
            Next j
        End If
    Next i
End With