Suppression colonne suivant l'heure dans une ligne
Bonjour à tous,
Je suis nouveau sur le forum et j’ai besoin de votre aide s’il vous plait.
Je suis en alternance dans une entreprise et je ne suis pas un expert en la matière concernant VBA. Suite à une extraction d’un logiciel j’obtiens le fichier suivant (pièce-jointe), le fichier varie suivant l’heure de l’extraction... j’ai commencé une macro pour obtenir ce que je souhaite (le nom du produit, la quantité commande, les manquants et les heures qui m’intéressent => Première macro de 8 h à 12 h (voir plus bas j'ai mis la VBA que j'ai faite pour l'instant).
Ce que je n’arrive pas c’est de garder que les colonnes des heures qui m’intéressent pour commencer, donc les colonnes inférieures et égales à 12 h, les colonnes suivantes sont à supprimer supérieur à 12 h! Sauf que parfois les colonnes varies (exemple : il n’y a pas de 10 h ou de 11 h ou les deux, etc…).
Bien sur je suis preneur si jamais la formule déjà existante est à améliorer
Merci par avance. Cordialement.
Formule VBA
Sub Test1()
'
' Test1 Macro
'
'
Range("C1").Select
ActiveCell.FormulaR1C1 = "Manquant"
Range("C2").Select
ActiveCell.FormulaR1C1 = "=SUMIF(R1C8:R1C17,""<=12:00"",RC[5]:RC[14])"
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C33")
Range("C2:C33").Select
Columns("D:G").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("C1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Feuil1").Sort
.SetRange Range("A2:L33")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=1", Formula2:="=40000"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("C1").Select
'
Do While Range("C2") = 0
Range("C2").EntireRow.Delete Shift = xlUp
Loop
End Sub
Bonjour et bienvenue sur le forum
Un essai à tester. Te convient-il ?
Bye !
C'est exactement ce que je voulais c'est parfait, j'ai juste oublié que dans le fichier quand je l'extrait il y a des valeurs en colonne A et B (ce qui fait que la colonne produits se trouve en colonne C...) que j'avais supprimé manuellement à la base pour envoyer le fichier, est-ce possible de rajouter pour les supprimer par VBA ?
J'aurais une autre question par la suite : je dois effectuer ceci pour les manquants du matin (ce que tu as très bien résolu), ensuite il y aura l'après-midi évidemment, c'est la que tout change puisqu'il faut heure par heure c'est à dire:
- Pour la 2ième macro j’ai besoin que de la colonne 13 h les autres colonnes sont à supprimer, même chose qu’avant les colonnes vont variées suivant les jours et l’heure qu’il est au moment de l’extraction du fichier !
- Pour la 3ième macro j’ai besoin que de la colonne 14 h les autres colonnes sont à supprimer, même chose qu’avant les colonnes vont variées suivant les jours et l’heure qu’il est au moment de l’extraction du fichier !
- Ainsi de suite pour les 4, 5 et 6ième macros (15 h, 16 h, 17 h) !
Il me faut donc 6 macro différentes, que je vais ensuite affecter à 6 boutons différents.
Je me suis débrouillé pour la suppression des deux premières colonnes ça fonctionne à merveille, merci beaucoup
Pour la suite au moins la colonne de 13 h j'ai essayé de faire quelque chose pour l'instant, chose que j'aurais juste à dupliquer pour les autres colonnes (en changeant les heures bien sur)
Voila ce que ça donne:
Sub Test2()
'
' Test2 Macro
'
'
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Range("C1").Select
ActiveCell.FormulaR1C1 = "Manquant"
Range("C2").Select
ActiveCell.FormulaR1C1 = _
"=SUMIFS(RC[5]:RC[14],R1C8:R1C17,""<=13:00"",R1C8:R1C17,"">12:00"")"
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C33")
Range("C2:C33").Select
Columns("C:C").Select
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("C1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Feuil1").Sort
.SetRange Range("A2:P33")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=1", Formula2:="=40000"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Do While Range("C2") = 0
Range("C2").EntireRow.Delete Shift:=xlUp
Loop
End Sub
C'est super merci beaucoup cela répond totalement à mes attentes
Je vais me débrouiller avec tout cela puisque les extractions je les fait pour la colonne 13h à 13h01, 14h à 14h01 etc... Les macros sont séparées mais c'est déjà super tout ce que tu as fait qui m'aide énormément pour la suite de mon travail
Bonjour à tous,
J'ai eu un petit soucis en faisant l'extraction ce matin, tout fonctionne très bien sauf que pour toute la journée (comme dans le dernier fichier que l'on m'a envoyé), je n'ai pas de colonne en 14 h et 17 h.. la recherche est longue et je n'obtiens pas de résultat puisque ça fait planter excel..
Merci par avance,
Cordialement.
Bonjour
benjiben a écrit :sauf que pour toute la journée (comme dans le dernier fichier que l'on m'a envoyé), je n'ai pas de colonne en 14 h et 17 h..
Envoie moi donc ce fichier qui pose problème...
Bye !
J'ai joint le fichier, pour aujourd'hui je n'ai donc rien de prévu pour 14 h et 17 h ce qui arrive certains jours de rien avoir pour certaines heures de la journée. Ce qui donne cela pour toute la journée en VBA:
Option Explicit
Dim derln&, dercol&, dercol2&, j&, f As Worksheet, fr As Worksheet
Sub Extraction()
'
' Extraction Macro
'
'
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Set f = ActiveSheet
Application.ScreenUpdating = False
dercol = Cells(1, Columns.Count).End(xlToLeft).Column
derln = Range("A" & Rows.Count).End(xlUp).Row
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "Matin"
Set fr = ActiveSheet
f.Cells.Copy fr.Range("A1")
For j = dercol To 8 Step -1
If fr.Cells(1, j).Value * 24 > 12 Then
fr.Columns(j).Delete
End If
Next j
Range("C2").FormulaR1C1 = "=SUMIF(R1C8:R1C11,""<=12:00"",RC[5]:RC[8])"
Call Extract
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "13h"
Set fr = ActiveSheet
f.Cells.Copy fr.Range("A1")
For j = dercol To 8 Step -1
If fr.Cells(1, j).Value * 24 <> 13 Then
fr.Columns(j).Delete
End If
Next j
Range("C2").FormulaR1C1 = "=RC[5]"
Call Extract
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "14h"
Set fr = ActiveSheet
f.Cells.Copy fr.Range("A1")
For j = dercol To 8 Step -1
If fr.Cells(1, j).Value * 24 <> 14 Then
fr.Columns(j).Delete
End If
Next j
Range("C2").FormulaR1C1 = "=RC[5]"
Call Extract
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "15h"
Set fr = ActiveSheet
f.Cells.Copy fr.Range("A1")
For j = dercol To 8 Step -1
If fr.Cells(1, j).Value * 24 <> 15 Then
fr.Columns(j).Delete
End If
Next j
Range("C2").FormulaR1C1 = "=RC[5]"
Call Extract
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "16h"
Set fr = ActiveSheet
f.Cells.Copy fr.Range("A1")
For j = dercol To 8 Step -1
If fr.Cells(1, j).Value * 24 <> 16 Then
fr.Columns(j).Delete
End If
Next j
Range("C2").FormulaR1C1 = "=RC[5]"
Call Extract
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "17h"
Set fr = ActiveSheet
f.Cells.Copy fr.Range("A1")
For j = dercol To 8 Step -1
If fr.Cells(1, j).Value * 24 <> 17 Then
fr.Columns(j).Delete
End If
Next j
Range("C2").FormulaR1C1 = "=RC[5]"
Call Extract
End Sub
Sub Extract()
Range("C1") = "Manquant"
Range("C2:C" &derln).FillDown
Range("C2").Select
Columns("D:G").Delete Shift:=xlToLeft
dercol2 = Cells(1, Columns.Count).End(xlToLeft).Column
With Range(Cells(2, 1), Cells(derln, dercol2))
.Sort key1:=Range("C2"), order1:=xlAscending, Header:=xlNo
.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=1", Formula2:="=40000"
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Range(Cells(2, 1), Cells(derln, dercol2)).FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
Range("C1").Select
Do While Range("C2") = 0
Range("C2").EntireRow.Delete Shift:=xlUp
Loop
End Sub
Et si jamais demain je n'ai pas de 13h et 15h mais que 14h et 16h par exemple ou 13h, 14h et 17h etc.. cela va fonctionner ?
Merci pour ton aide.
benjiben a écrit :Et si jamais demain je n'ai pas de ...
Et bien, on verrai ça, mais ça devrait marcher quand même....
Bye !
Bonjour,
C'est parfait cela fonctionne à merveille, j'ai du 13, 14, 16 et 17h et tout à marcher correctement
Merci beaucoup en tout cas