VBA plusieurs problèmes (suppressions lignes sur conditions et autre)

elroro

XLDnaute Nouveau
Bonjour,

Je débute en VBA sous excel et je n’arrive pas à résoudre un problème.

Dans le fichier joint, il y a la macro que j’ai commencé à réaliser. Il y a également un onglet original qui correspond à ce que je récupère d’un autre logiciel, un onglet « apres macro actuel » qui donne le résultat de ma macro.

Mon problème est que je voudrais ajouter à ma macro une fonction qui donnerait : Supprimer les lignes lorsque la cellule correspondante en colonne D est vide. J’avais réussi mais ma plage de ligne totale était fixe et ce n’est pas le cas car les données que je récupère peuvent aller de 10 à 15000 voire plus ou moins. (Le résultat de ce que je veux est dans final 1)

Mon deuxième problème est que je voudrais supprimer les doublons : C’est-à-dire que je me retrouve avec des textes colonne D qui ont un écart de moins de 3 minutes. Je voudrais donc les supprimer en gardant uniquement le premier (par rapport à l’heure et la date bien sûr).
Il se peut que la répétition se fasse sur des dizaines de minutes donc je pense qu’il faudra les contrôler en commencer par la ligne la plus basse.
Il y a une autre contrainte qui n’apparait pas dans mon exemple, il peut arriver que les textes en D se chevauchent donnant ainsi des doublons sur des lignes que ne suivent pas. Il y a un exemple dans l’onglet « doublons » qui n’a rien à voir avec le fichier de départ (juste pour exemple).
On ne peut donc pas contrôler si il y a doublons entre 2 lignes successive mais uniquement en utilisant la date et l’heure

Je vous remercie d’avance de votre aide et désolé si mes explications ne sont pas très claires.
 

Pièces jointes

  • releve defauts.xlsm
    58.7 KB · Affichages: 55

Staple1600

XLDnaute Barbatruc
Re : VBA plusieurs problèmes (suppressions lignes sur conditions et autre)

Bonsoir



Essaies cette macro de test (donc à tester sur un CLASSEUR VIERGE créé pour l'occasion)
qui lance deux macros qui supprime les lignes vides selon deux méthodes
(Lance la macro test deux fois de suite ensuite va dans VBE pour voir quelles méthodes sont utilisées)
Code:
Sub test()
Dim t: Cells.Clear
Range("A1") = "a1": Range("A1").AutoFill Destination:=Range("A1:D1"), Type:=xlFillDefault
Range("A2:D2") = "1": Range("A4:D4") = "2"
Range("A2:D5").AutoFill Destination:=Range("A2:D40"), Type:=xlFillDefault
t = MsgBox("Lancer la version 1 (Cliquer sur OUI), la version 2 (Cliquer sur NON)", vbYesNo + vbQuestion, "TEST SUPPRESSION LIGNES VIDES Colonne D")
Select Case t
Case 6
MsgBox "Suppression avec Méthode 1: SpecialCells": v1
Case 7
MsgBox "Suppression avec Méthode 2: Tri croissant": v2
End Select
End Sub
Code:
Sub v1()
On Error Resume Next
Columns("d:d").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
End Sub
Code:
Sub v2()
Range("A1:D40").Sort _
Key1:=Range("D2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End Sub

Si tu as des questions , repasse sur le fil ;)
 

Staple1600

XLDnaute Barbatruc
Re : VBA plusieurs problèmes (suppressions lignes sur conditions et autre)

Bonour à tous

Marion ou Sébastien ;)
Je te laisse tester ce code VBA perfectible
(NB: Pas sur d'obtenir le résultat final, mais ela te fait une piste à creuser pour combler cette fin d’après-midi dominical)
Code:
Sub RecupDefautsII()
Dim source As Worksheet
Dim pf As Range
Set source = Sheets("Original")
source.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "TEST"
Sheets("TEST").Activate
' Suppression des colonnes qui ne servent pas
Application.ScreenUpdating = False
Columns("A:I").Delete: Columns("B:D").Delete: Columns("C:D").Delete
Columns("D:J").Delete: Columns("E:G").Delete: Columns("F:V").Delete


Columns("E:E").TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:=":", FieldInfo:=Array(Array(1, 9), Array(2, 1)), _
TrailingMinusNumbers:=True

Range("A1").CurrentRegion.AutoFilter Field:=5, Criteria1:="<>*.*", Operator:=xlAnd

Set pf = [_FilterDatabase]
pf.Offset(1).Resize(pf.Rows.Count - 1).SpecialCells(12).EntireRow.Delete
ActiveSheet.AutoFilterMode = False: Range("E1") = Empty
'
'Supprimer la colonne B
Columns("B:B").Delete
'
''Remplacer le texte".." par du vide
Range("A1:C" & Range("A65536").End(xlUp).Row).Replace What:="Time:", Replacement:=""

' transformer date en jour pour colonne A
For Each c In Range("A1:A" & Range("A" & Application.Rows.Count).End(xlUp).Row)
    c.Value = Left(c, 10)
    c.NumberFormat = "dddd"
Next c
'
' transformer date en date pour colonne B
For Each d In Range("B1:B" & Range("B" & Application.Rows.Count).End(xlUp).Row)
    d.Value = Left(d, 10)
    d.NumberFormat = "dd/mm/yyyy"
Next d

' remplacer les points par deux points pour heure
Columns("C:C").Replace What:=".", Replacement:=":"
'
'transformer date en date pour colonne C
For Each e In Range("C1:C" & Range("C" & Application.Rows.Count).End(xlUp).Row)
    e.Value = Right(e, 8)
    e.NumberFormat = "hh:mm:ss"
Next e

'Mise en forme
Columns("A:A").ColumnWidth = 8: Columns("B:B").ColumnWidth = 11
Columns("C:C").ColumnWidth = 9: Columns("D:D").ColumnWidth = 25

Range("C1:C" & Range("A" & Rows.Count).End(xlUp).Row).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Sheets("TEST").Range("A1").EntireRow.Insert
Sheets("TEST").Range("A1") = "ENT1"
Sheets("TEST").Range("A1").AutoFill Destination:=Sheets("TEST").Range("A1").Range("A1:D1"), Type:=xlFillDefault

doublons

Application.ScreenUpdating = True
End Sub
Code:
Sub doublons()
Dim nf As Worksheet
Set nf = Sheets.Add
With nf
    Sheets("TEST").Range("A1:D35").AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=.Range("A1"), Unique:=True
End With
End Sub
 

Staple1600

XLDnaute Barbatruc
Re : VBA plusieurs problèmes (suppressions lignes sur conditions et autre)

Re

Si je pars de ta feuille Final1 (qui contient 48 lignes)
(je la renomme TEST)
et que je lance la macro ci-dessous pour supprimer les doublons
Code:
Sub doublonsII()
Sheets("TEST").Select
Sheets.Add
Sheets("TEST").Range("A1:D49").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("A1"), Unique:=True
End Sub
J'obtiens 21 lignes (je ne compte pas la ligne d'entête)

Or ce n'est pas ce tu obtiens en feuille Final2
(seulement 6 lignes)

Je ne comprend sur quels critères tu te bases pour tes doublons ?
(moi j'ai pris les heures identiques pour un même jour)
 

elroro

XLDnaute Nouveau
Re : VBA plusieurs problèmes (suppressions lignes sur conditions et autre)

Merci pour vos réponse, je n'aurais pas le temps de tester tout de suite, pas avant lundi.
Pour mes doublons je procède de la sorte :

Dans l'onglet final1 => Le premier Isol. TGBT est arrivé à 09:09:37 et ce répète à intervalle de moins de 3 minutes jusqu'à 09:19:42 donc c'est uniquement le premier qui est apparu à 09:09:37 qu'il faut que je conserve.

Si je prend pour exemple Def. temperature qui est apparu a 04:45:28, il se répète à intervalle de moins de 3 minutes jusqu'à 04:47:30 donc je ne conserve que le premier de 04:45:28
Celui qui est apparu à 05:20:02 est bien à plus de 3 minutes de celui de 04:45:28 donc je le garde.
Et ainsi de suite.

Je sais pas si c'est plus clair comme ceci !

Merci
 

Discussions similaires

Statistiques des forums

Discussions
312 193
Messages
2 086 059
Membres
103 110
dernier inscrit
Privé