XL 2016 Macro Dim c As Range, i As Long

_l_ours

XLDnaute Nouveau
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 :)
 
Solution
Bonjour @_l_ours

Je te propose ceci
VB:
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

Phil69970

XLDnaute Barbatruc
Bonjour @_l_ours

Je te propose ceci
VB:
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
 
Dernière édition:

patty58

XLDnaute Occasionnel
Bonjour à tous,

Essaie cela :

VB:
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

XLDnaute Barbatruc
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
VB:
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
 

mapomme

XLDnaute Barbatruc
Supporter XLD
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 :
VB:
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
 

Pièces jointes

  • _l_ours- remplir colonne si- v1.xlsm
    22.4 KB · Affichages: 2
Dernière édition:

Discussions similaires

Réponses
9
Affichages
118
Réponses
5
Affichages
186

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 861
Messages
2 092 962
Membres
105 571
dernier inscrit
MAT30190