XL 2016 Macro Dim c As Range, i As Long

[_l_ours]

Bonjour à tous,

j'ai besoin d'aide sur une macro, ce ne doit pas être très compliqué, mais j'ai fait plusieurs recherches, et je ne trouve pas vraiment.

L'idée de la macro est la suivante : pour chaque ligne où la cellule de la colonne A est remplie, il faut chercher dans la colonne G (colonne 7) si le mot "modifications", "parcours" ou "branchement" apparait, et si oui, il faut écrire en colonne H (colonne 8) de la même ligne le mot "travaux".

Je pense que le problème vient de mon instruction "If" où la conséquence "Then" n'est pas bien formulée.

Dim c As Range, i As Long
With Sheets("export")
For i = .Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
Set c = Columns(7).Find(Range("A" & i).Value)
If c = "modifications" Then [c+1] = "travaux"
Next i
For i = .Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
Set c = Columns(7).Find(Range("A" & i).Value)
If c = "parcours" Then [c+1] = "travaux"
Next i
For i = .Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
Set c = Columns(7).Find(Range("A" & i).Value)
If c = "branchement" Then [c+1] = "travaux"
Next i
End With

merci d'avance pour votre aide

 

[Phil69970]

Bonjour @_l_ours

Je te propose ceci

Option Explicit

Sub CopieMot()
Dim i&, Derlig&
With Sheets("export")
    Derlig = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row 'To 1 Step -1
        If Range("G" & i) = "modifications" Or Range("G" & i) = "parcours" Or Range("G" & i) = "branchement" Then
            Range("H" & i) = "Travaux"
        End If
    Next i
End With
End Sub

 

[patty58]

Bonjour à tous,

Essaie cela :

Dim i As Long
DLig = Sheets("export").Range("A65536").End(xlUp).Row
For i = 1 To DLig
    If Cells(i, 1) <> "" Then
        Select Case Cells(i, 7)
            Case "modifications", "parcours", "branchement"
                Cells(i, 8) = "travaux"
            Case Else
        End Select
    End If
Next i

Bonne soirée

 

[patricktoulon]

bonsoir
@patty58 il y a intérêt a ce que la macro soit déclenchée
quand c'est la bonne feuille qui est active


bon allez j'en elève encore un peu

Dim i As Long
with Sheets("export")
For i = 1 To .Range("A65536").End(xlUp).Row
    .Cells(i, 8) = Array("travaux", .Cells(i, 8))(Abs(" modifications parcours branchement " Like "* " & .cells(i, 7) & " *"))
Next i
end with

 

[patty58]

Bonjour à tous
@patrick , oui, tu as raison , j'ai vu mon oubli.
Désolée, j'ai honte ..
Bonne nuit, vu l'heure!!

 

[patty58]

Bonjour à tous
@patrick , oui, tu as raison , j'ai vu mon oubli.
Désolée, j'ai honte ..
Bonne nuit, vu l'heure!!

Je rajoute cela : il me semble que tu ne mets pas le mot "travaux" quand il le faut, à moins que je n'ai pas bien interprété, auquel cas il faut mieux que j'aille me coucher immédiatement.

 

[patricktoulon]

ben tu n'a pas compris l'astuce en fait regarde bien

 

[_l_ours]

Merci beaucoup à tous, @patricktoulon @patty58 @Phil69970 ,
j'ai privilégié la solution de @Phil69970 car la macro ne se limite pas à en terme de ligne, le fichier risque d'être très volumineux en terme de lignes (environs 400k lignes).
Merci à tous et bonne journée

 

[mapomme]

Bonjour à tous ,

Un code qui devrait être rapide s'il y a de nombreuses lignes :

Si j'ai bien compris :

• on vide la colonne H
• si la cellule en A n'est pas vide, on regarde si un des mots clefs figure dans la cellule de la colonne G
• si c'est le cas, on indique "travaux" dans la cellule de la colonne H

• le code ne distinguent pas la casse (majuscule / minuscule)
• les mots-clef à rechercher sont à mettre dans la constante MotClef (le séparateur des mots-clefs est l'espace)

Cliquez sur le bouton vert pour initialiser les données puis cliquer sur le bouton bleu pour remplir la colonne H.

Le code dans module1 :

Sub Travaux()
Const MotClef = "modifications parcours branchement"
Dim der&, ta, tg, th, s, ns&, i&, k&, debut
  
   debut = Timer: Application.ScreenUpdating = False
   With Sheets("Feuil1")
      If .FilterMode Then .ShowAllData
      .Columns("h:h").ClearContents
      der = .Cells(Rows.Count, "a").End(xlUp).Row
      ta = .Range("a1:a" & der): tg = .Range("g1:g" & der): th = .Range("h1:h" & der)
      s = Split(MotClef): ns = UBound(s)
      For i = 1 To UBound(ta)
         If ta(i, 1) <> "" Then
            For k = 0 To ns
               If InStr(1, tg(i, 1), s(k), vbTextCompare) > 0 Then th(i, 1) = "travaux": Exit For
            Next k
         End If
      Next i
      .Range("h1").Resize(UBound(th)) = th
   End With
   MsgBox "Pour " & Format(der, "#,##0") & " lignes, durée = " & Format(Timer - debut, "#,##0.00\ sec.")
End Sub