Supprimer cellules en fonction du nom colonne A

[didinelfange]

Bonjour à tous,

C'est re-moi, après avoir appliqué tous vos précieux conseils ma macro marchait enfin (YES!!!!). Je décide donc toute fière de la montrer à mon chef, et là, catastrophe..... Le fichier txt extrait de l'application est mal renseigné mes données entrées sur Excel sont fausses (je vais me tuer) Ainsi, je dois donc avant tout faire du nettoyage.
J'aurais donc besoin d'une macro qui me permette de supprimer toutes les cellules d'une même ligne à partir de la colonne E ne commençant pas par "nomappli" de la colonne A . Je vous joins le fichier exemple.

Je vous remercie de votre aide.

 

[Lolote83]

Re : Supprimer cellules en fonction du nom colonne A

Salut DIDINELFANGE,
Si j'ai bien compris, une petite macro ci jointe
@+ Lolote83

 

[didinelfange]

Re : Supprimer cellules en fonction du nom colonne A

Bonjour et merci pour cette réponse ultra rapide,

Mais mes appilcations portent des noms plus ou moins longs, je ne peux donc pas lui donner un nombre de caractères définis, juste ce qui est avant le point .

Merci de votre aide

 

[Lolote83]

Re : Supprimer cellules en fonction du nom colonne A

Re salut,
Peut être alors modifier la macro comme suit.
Sans exemple concret, j'y vais à l'aveugle.

Sub SupprimeJaune()
    Application.ScreenUpdating = False
    For Each xCell In Range("E1:N26")
        If xCell.Value <> Empty Then
            xNomColA = Cells(xCell.Row, "A")
            xPoint = InStr(1, xCell.Value, ".")
            If Left(xCell.Value, xPoint - 1) <> xNomColA Then
                xCell.Value = Empty
            End If
        End If
    Next xCell
    Application.ScreenUpdating = True
End Sub

@+ Lolote83

 

[klin89]

Re : Supprimer cellules en fonction du nom colonne A

Bonsoir le fil

Comme je manie mal les chaines de caractères, c'est sûrement perfectible

Option Explicit
Sub efface()
Dim i As Long, j As Long
    Application.ScreenUpdating = False
    With Sheets("Feuil1").Range("a1").CurrentRegion
        .Interior.ColorIndex = xlNone
        For i = 1 To .Rows.Count
            For j = 5 To .Columns.Count
                If InStr(1, .Cells(i, j), .Cells(i, 1), vbTextCompare) = 0 Then
                    'surligne
                    Cells(i, j).Interior.ColorIndex = 40
                End If
                'efface
                'If InStr(1, .Cells(i, j), .Cells(i, 1), vbTextCompare) = 0 Then Cells(i, j).Clear
            Next
        Next
    End With
    Application.ScreenUpdating = True
End Sub

puisque la comparaison doit s'effectuer avant le point
klin89

 

[mapomme]

Re : Supprimer cellules en fonction du nom colonne A

Bonjour didinelfange,

Un autre essai:

Option Explicit
Option Compare Text

Sub efface()
Dim tablo, i&, j&, appli
  With Sheets("Feuil1")
    tablo = .Range("a1").CurrentRegion.Value
    For i = 1 To UBound(tablo)
      appli = tablo(i, 1) & "." & "*"
      For j = 5 To UBound(tablo, 2)
        If Not (tablo(i, j) Like appli) Then tablo(i, j) = Empty
      Next j
    Next i
    .Range("a1").Resize(UBound(tablo), UBound(tablo, 2)) = tablo
  End With
End Sub

 

[didinelfange]

Bonjour tout le monde,

après un long moment d'absence, je reviens (le diplôme en poche, yes !!!!! ) .
Je vous remercie pour votre aide, la macro fonctionne bien .
J'ai cependant quelques cas particuliers et je ne sais pas s'il est possible d'appliquer la formule de mapomme pour ces cas.
Je vous explique tout dans le fichier exemple.

Je vous remercie par avance de votre réponse.

 

[mapomme]

Bonsoir didinelfange,

Un essai dans le fichier joint. Seule la confrontation aux données réelles (avec les vrais noms de vos applications) pourra laisser supposer que la macro fonctionne correctement. Le code est dans module2.

Option Explicit
Option Compare Text

Sub Efface_v2()
  Dim tablo, i&, j&, appli, p&
  With ActiveSheet
    tablo = .Range("a1:n" & .Cells(.Rows.Count, "a").End(xlUp).Row).Value
    For i = 1 To UBound(tablo)
      For j = 5 To UBound(tablo, 2)
        If Len(Trim(tablo(i, j))) > 0 Then
          p = InStr(1, tablo(i, j), ".", vbTextCompare)
          If p = 0 Then
            appli = Trim(tablo(i, j))
          Else
            appli = Left(tablo(i, j), p - 1)
          End If
          If (Not (tablo(i, 1) Like "*_" & appli & "*") And _
             Not (tablo(i, 1) Like "*" & appli & "_*")) And _
             Not (tablo(i, 1) = appli) Then tablo(i, j) = Empty
        Else
          tablo(i, j) = Empty
        End If
      Next j
    Next i
    .Range("a1").Resize(UBound(tablo), UBound(tablo, 2)) = tablo
  End With
End Sub

Edit : préférez la version v2a qui corrige une erreur de logique.

 

[didinelfange]

Bonjour à tous et un grand merci, ça marche au poil !!!!!