Si une cellule contient...Alors

Bonjour,

J'ai un soucis avec une macro.

Je voudrais qu'elle ajoute une colonne "Bâtiment" à un tableau existant.

Ensuite, qu'elle vérifie le contenu des cellules de la colonne "Poste":

Si la cellule contient "MA", la cellule dans la même ligne, mais dans la colonne "Bâtiment" aurait comme valeur "Main-d'oeuvre".

De même, si la cellule contient "NA", la cellule dans la même ligne, mais dans la colonne "Bâtiment" aurait comme valeur "Non-Applicable".

Je ne sais pas si j'ai été clair dans mes explications. J'ai fait un début de code, mais ne parvient pas à le finir

Sub Contient()
Dim SrchRng As Range, cel As Range
    With Sheets("Feuil1").ListObjects(1)
        .ListColumns.Add.Name = "Bâtiment"
    End With
Set SrchRng = ActiveSheet.ListObjects("tableau1").ListColumns("Poste").DataBodyRange
For Each cel In SrchRng
       If InStr(1, cel.value, "MA")<> 0 Then
           (Cellule dans la colonne Bâtiment mais dans la même ligne).Value = "Main d'oeuvre"
       ElseIf InStr(1, cel.value, "NA")<> 0 Then
           (Cellule dans la colonne Bâtiment mais dans la même ligne).Value = "Non applicable"    
       End If
Next cel
End Sub

Misen

Bonsoir,

Voilà un exemple de ce que l'on peut faire

Sub Contient()
  Dim SrchRng As Range, cel As Range, Test As Range
  ' Avec Feuil1 taableau 1
  With Sheets("Feuil1").ListObjects(1)
    ' En cas d'erreur continuer
    On Error Resume Next
    ' Définir la plage de la colonne Bâtiment, si existe
    Set Test = .ListColumns("Bâtiment").DataBodyRange
    ' Si une erreur est déclarée = la colonne n'existe pas
    If Err.Number <> 0 Then
      ' Créer la colonne
      .ListColumns.Add.Name = "Bâtiment"
    End If
    On Error GoTo 0
  End With
  ' Définir la plage de recherche
  Set SrchRng = ActiveSheet.ListObjects("tableau1").ListColumns("Poste").DataBodyRange
  ' Pour chaque cellule de cette plage
  For Each cel In SrchRng
    If InStr(1, cel.Value, "MA") <> 0 Then
      '(Cellule dans la colonne Bâtiment mais dans la même ligne).Value
      cel.Offset(0, 1).Value = "Main d'oeuvre"
    ElseIf InStr(1, cel.Value, "NA") <> 0 Then
      '(Cellule dans la colonne Bâtiment mais dans la même ligne).Value
      cel.Offset(0, 1).Value = "Non applicable"
    End If
  Next cel
End Sub

A+

Bonsoir,

Voilà un exemple de ce que l'on peut faire

Sub Contient()
  Dim SrchRng As Range, cel As Range, Test As Range
  ' Avec Feuil1 taableau 1
  With Sheets("Feuil1").ListObjects(1)
    ' En cas d'erreur continuer
    On Error Resume Next
    ' Définir la plage de la colonne Bâtiment, si existe
    Set Test = .ListColumns("Bâtiment").DataBodyRange
    ' Si une erreur est déclarée = la colonne n'existe pas
    If Err.Number <> 0 Then
      ' Créer la colonne
      .ListColumns.Add.Name = "Bâtiment"
    End If
    On Error GoTo 0
  End With
  ' Définir la plage de recherche
  Set SrchRng = ActiveSheet.ListObjects("tableau1").ListColumns("Poste").DataBodyRange
  ' Pour chaque cellule de cette plage
  For Each cel In SrchRng
    If InStr(1, cel.Value, "MA") <> 0 Then
      '(Cellule dans la colonne Bâtiment mais dans la même ligne).Value
      cel.Offset(0, 1).Value = "Main d'oeuvre"
    ElseIf InStr(1, cel.Value, "NA") <> 0 Then
      '(Cellule dans la colonne Bâtiment mais dans la même ligne).Value
      cel.Offset(0, 1).Value = "Non applicable"
    End If
  Next cel
End Sub

A+

Bon matin,

C'est ça que je recherchais!

Merci beaucoup!

Cordialement,

Misen

Rechercher des sujets similaires à "contient"