Suppression de donnés toutes les 3 colonnes

Le 03/12/2018 à 09:03

Bonjour

Dans un tableau , je veux supprimer les données de colonnes mais toutes les 3 colonnes.

Pour la largeur du tableau, il commence en cellule U5 et se termine en CO5,

Pour la longueur du tableau (lignes), il est évolutif.

Je souhaite donc supprimer les données des colonnes U, X, AA, AD... ainsi de suite jusqu'à la fin du tableau.

Merci de votre aide.

Cdt

Fred.

Le 03/12/2018 à 09:25

Bonjour,

Il s'agit de supprimer les colonnes ou juste de supprimer le contenu ? Comme il n'y a pas vraiment de question dans ton post, je me demande ce que tu as réellement besoin ? Une méthode pour supprimer manuellement les données ? Une macro pour le faire automatiquement ?

Le 03/12/2018 à 09:35

Bonjour,

Bonjour Pedro22,

Essaie d'envoyer un fichier représentatif de tes données (pas besoin de 50.000 lignes).

Que l'on voit la structure des données (plage de cellules ou tableau, en-têtes de colonnes, etc...)

Cdlt.

Le 03/12/2018 à 09:42

Bonjour Fred, le forum,

je te propose ce fichier Excel :

16exo-fred56.xlsm (19.35 Ko)

Ctrl e ➯ travail effectué

Alt F11 pour voir le code VBA, puis revenir sur Excel

si besoin, tu peux demander une adaptation.

merci de me dire si ça te convient.

dhany

Le 03/12/2018 à 10:03

Bonjour Dhany

C'est exactement ce que je cherchais.

J'ai inséré ton code dans le code que j'avais.

Mais cela ne fonctionne pas.

Aussi dans le code joint, ton code doit replacer toute la première partie où je sélectionne toutes las plages à supprimer de manière individuelle.

Merci de ton aide.

le code :

Sub Import_CmD_X3()

Dim i, vsemaine As Integer

Dim varticle As String

Dim vqté As Long

Dim lig, col, ligArt, colSem As Integer

'MsgBox Ok + Annuler

MonAlerte = MsgBox("Opération irréversible. Souhaitez-vous continuez ?", vbOKCancel, "Mise à jour des commandes X3 ...")

If MonAlerte = vbCancel Then

Exit Sub

End If

Range("U5:U1000").Select

Range("U5:U1000,X5:X1000").Select

Range("U5:U1000,X5:X1000,AA5:AA1000").Select

Range("U5:U1000,X5:X1000,AA5:AA1000,AD5:AD1000").Select

Range("U5:U1000,X5:X1000,AA5:AA1000,AD5:AD1000,AG5:AG1000,AJ5:AJ1000").Select

Range( _

"U5:U1000,X5:X1000,AA5:AA1000,AD5:AD1000,AG5:AG1000,AJ5:AJ1000,AM5:AM1000,AP5:AP1000,AS5:AS1000" _

).Select

Range( _

"U5:U1000,X5:X1000,AA5:AA1000,AD5:AD1000,AG5:AG1000,AJ5:AJ1000,AM5:AM1000,AP5:AP1000,AS5:AS1000,AV5:AV1000,AY5:AY1000,BB5:BB1000,BE5:BE1000,BH5:BH1000" _

).Select

Range( _

"U5:U1000,X5:X1000,AA5:AA1000,AD5:AD1000,AG5:AG1000,AJ5:AJ1000,AM5:AM1000,AP5:AP1000,AS5:AS1000,AV5:AV1000,AY5:AY1000,BB5:BB1000,BE5:BE1000,BH5:BH1000,BK5:BK1000,BN5:BN1000,BQ5:BQ1000" _

).Select

Range( _

"U5:U1000,X5:X1000,AA5:AA1000,AD5:AD1000,AG5:AG1000,AJ5:AJ1000,AM5:AM1000,AP5:AP1000,AS5:AS1000,AV5:AV1000,AY5:AY1000,BB5:BB1000,BE5:BE1000,BH5:BH1000,BK5:BK1000,BN5:BN1000,BQ5:BQ1000,BT5:BT1000,BW5:BW1000,BZ5:BZ1000,CC5:CC1000" _

).Select

Range( _

"U5:U1000,X5:X1000,AA5:AA1000,AD5:AD1000,AG5:AG1000,AJ5:AJ1000,AM5:AM1000,AP5:AP1000,AS5:AS1000,AV5:AV1000,AY5:AY1000,BB5:BB1000,BE5:BE1000,BH5:BH1000,BK5:BK1000,BN5:BN1000,BQ5:BQ1000,BT5:BT1000,BW5:BW1000,BZ5:BZ1000,CC5:CC1000,CF5:CF1000,CI5:CI1000" _

).Select

Range( _

"U5:U1000,X5:X1000,AA5:AA1000,AD5:AD1000,AG5:AG1000,AJ5:AJ1000,AM5:AM1000,AP5:AP1000,AS5:AS1000,AV5:AV1000,AY5:AY1000,BB5:BB1000,BE5:BE1000,BH5:BH1000,BK5:BK1000,BN5:BN1000,BQ5:BQ1000,BT5:BT1000,BW5:BW1000,BZ5:BZ1000,CC5:CC1000,CF5:CF1000,CI5:CI1000" _

).Select

Selection.ClearContents

Range("U5").Select

Application.Calculation = xlCalculationManual

Application.ScreenUpdating = False

Sheets("DataExtract_TbDynCmDMP").Select ' Range("A2").Select

lig = 2

Do While Not IsEmpty(Cells(lig, 1))

vsemaine = Cells(lig, 1)

varticle = Cells(lig, 2)

vqté = Cells(lig, 7)

Sheets("STOCKS MP").Select

' recherche de la ligne correspondant à l'article ATTENTION la dernière ligne de la colonne article (colonne 2) doit se terminer par "FinListe"

' contrôle qu'il y a bien une cellule "FinListe" dans les 3000 premières lignes

i = 1

Do While i <= 3000 And Cells(i, 2) <> "FinListe"

i = i + 1

Loop

If i > 3000 Then

Rep = MsgBox("L'indication FinListe n'a pas été trouvée dans les 3000 premières lignes de la colonne B de la feuille STOCKS MP" & Chr(10) & "ABANDON DE LA MACRO", vbCritical)

End

End If

ligArt = 5 ' ligne contenant l'article

Do While Cells(ligArt, 2) <> "FinListe" And Cells(ligArt, 2) <> varticle

ligArt = ligArt + 1

Loop

If Cells(ligArt, 2) <> varticle Then

' MsgBox "Article " & varticle & " non trouvé"

Else

' recherche de la colonne correspondant à la semaine

colSem = 19 ' la recherche se fait à partir de la colonne T

Do While Not IsEmpty(Cells(2, colSem)) And Cells(2, colSem) <> vsemaine

colSem = colSem + 1

Loop

If Cells(2, colSem) <> vsemaine Then

' MsgBox "Semaine " & vsemaine & " non trouvée"

Else

' si on a trouvé l'article et la semaine correspondante, on copie la qté lue dans la feuille DataExtract colonne "COMM."

If colSem = 19 Then ' pour la 1ère semaine la colonne COMM. est 2 colonnes plus loin et 1 pour semaines les suivantes

Cells(ligArt, colSem + 2) = vqté

'Cells(ligArt, colSem + 2).Interior.ColorIndex = 2

Else

Cells(ligArt, colSem + 1) = vqté

'Cells(ligArt, colSem + 1).Interior.ColorIndex = 2

End If

End If

End If

Sheets("DataExtract_TbDynCmDMP").Select

lig = lig + 1

Loop

Sheets("STOCKS MP").Select

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

MsgBox "Mise à jour des commandes X3 terminée ..."

End Sub

Le 03/12/2018 à 10:13

bonjour à tous

mon avis : ne JAMAIS supprimer de données

ajouter des colonnes pour les nouvelles données si nécessaire

note : il est déconseillé d'utiliser autant de colonnes

pourquoi en as-tu besoin ?

à quoi sert ton fichier ?

à te relire

Le 03/12/2018 à 10:28

Bonjour JMD

C'est un tableau de CBN.

Il s'agit d'un tableau qui prend en compte notamment des commandes.

Il évolue avec les semaines.

Une semaine écoulée... plus besoin des données de cette semaine, ou nouvelle commande donc nécessite une mise à jour du tableau.

Voilà pour l'explication.

Merci de ton intérêt.

Fred

Le 03/12/2018 à 11:17

CBN ? ? ?

note : des commandes ça s'enregistre par lignes. Sans JAMAIS rien effacer

on fait des TCD pour des vues par semaines/mois/années ou clients etc.

en pratique, il n'y a aucune formule, ni aucun VBA

sauf parfois des SEMAINE ISO()

amitiés

Le 03/12/2018 à 11:19

@Fred56

essaye ce code VBA :

Option Explicit

Sub Import_CmD_X3()

  Dim MonAlerte As Integer, Rep As Integer

  Dim varticle As String
  Dim vqté As Long
  Dim vsemaine As Integer

  Dim lig As Long, ligArt As Long, i As Long
  Dim col As Integer, colSem As Integer

  'MsgBox Ok + Annuler
  MonAlerte = MsgBox("Opération irréversible. Souhaitez-vous continuez ?", vbOKCancel, "Mise à jour des commandes X3 ...")
  If MonAlerte = vbCancel Then Exit Sub

  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False

  i = Cells(Rows.Count, "U").End(xlUp).Row - 4
  If i > 1 Then
    For col = 21 To 93 Step 3 'cols U à CO
      Cells(5, col).Resize(i).ClearContents
    Next col
  End If
  Range("U5").Select

  Worksheets("DataExtract_TbDynCmDMP").Select ' Range("A2").Select
  lig = 2
  Do While Not IsEmpty(Cells(lig, 1))
    vsemaine = Cells(lig, 1)
    varticle = Cells(lig, 2)
    vqté = Cells(lig, 7)

    Worksheets("STOCKS MP").Select

    ' recherche de la ligne correspondant à l'article
    ' ATTENTION : la dernière ligne de la colonne article (colonne 2) doit se terminer par "FinListe"
    ' contrôle qu'il y a bien une cellule "FinListe" dans les 3000 premières lignes
    i = 1
    Do While i <= 3000 And Cells(i, 2) <> "FinListe"
      i = i + 1
    Loop
    If i > 3000 Then
      Rep = MsgBox("L'indication FinListe n'a pas été trouvée dans les 3000 premières lignes " _
        & "de la colonne B de la feuille STOCKS MP" & Chr(10) & "ABANDON DE LA MACRO", vbCritical)
      End
    End If

    ligArt = 5 ' ligne contenant l'article
    Do While Cells(ligArt, 2) <> "FinListe" And Cells(ligArt, 2) <> varticle
      ligArt = ligArt + 1
    Loop

    If Cells(ligArt, 2) <> varticle Then
      ' MsgBox "Article " & varticle & " non trouvé"
    Else
      ' recherche de la colonne correspondant à la semaine
      colSem = 19 ' la recherche se fait à partir de la colonne T
      Do While Not IsEmpty(Cells(2, colSem)) And Cells(2, colSem) <> vsemaine
        colSem = colSem + 1
      Loop
      If Cells(2, colSem) <> vsemaine Then
        ' MsgBox "Semaine " & vsemaine & " non trouvée"
      Else
        ' si on a trouvé l'article et la semaine correspondante, on copie la qté lue dans la feuille DataExtract colonne "COMM."
        If colSem = 19 Then ' pour la 1ère semaine la colonne COMM. est 2 colonnes plus loin et 1 pour semaines les suivantes
          Cells(ligArt, colSem + 2) = vqté
          'Cells(ligArt, colSem + 2).Interior.ColorIndex = 2
        Else
          Cells(ligArt, colSem + 1) = vqté
          'Cells(ligArt, colSem + 1).Interior.ColorIndex = 2
        End If
      End If
    End If

    Worksheets("DataExtract_TbDynCmDMP").Select

    lig = lig + 1

  Loop

  Worksheets("STOCKS MP").Select
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
  MsgBox "Mise à jour des commandes X3 terminée ..."

End Sub

j'ai juste indenté ton code VBA, et inséré mon p'tit bout d'code VBA dans le tien ; rien d'plus :

n'ayant pas tes données, j'ai pas vérifié ton code VBA, et j'suppose qu'il est ok.

dhany

Le 03/12/2018 à 11:42

Dhany

Ok cela fonctionne parfaitement .

La procédure est plus rapide, c'est exactement ce que je cherché.

Merci beaucoup, je te souhaite une très bonne journée.

Cdt,

Fred

Le 03/12/2018 à 11:44

merci pour ton retour !

très bonne journée à toi aussi !

dhany

Rechercher des sujets similaires à "suppression donnes toutes colonnes"