Comment insérer des lignes avec dates manquantes + Cf ci-dessous

Résolu
Lionel -  
Frenchie83 Messages postés 2240 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

Alors, je vais essayer d'être clair au maximum du possible

Ce que j'ai après import des données :

colonne 1 / colonne 2 / Colonne 3
date / Etape / valeur
12/10/2015 MISE EN CASSETTE 1010
12/10/2015 MISE EN HYPERCENTRE 749
12/10/2015 INCLUSION 754
12/10/2015 COUPE 1004
12/10/2015 RENDU PLATEAU MORPHO 346
12/10/2015 RENDU PLATEAU IHC 197
12/10/2015 RENDU PLATEAU CYTO 193
12/10/2015 RENDU PLATEAU FISH 6

Ce que je voudrais :
colonne 1 / colonne 2 / Colonne 3
date / Etape / valeur
12/10/2015 MISE EN CASSETTE 1010
12/10/2015 MISE EN HYPERCENTRE 749
12/10/2015 INCLUSION 754
12/10/2015 COUPE 1004
12/10/2015 RENDU PLATEAU MORPHO 346
12/10/2015 RENDU PLATEAU IHC 197
12/10/2015 RENDU PLATEAU IF/PF/HE 0
12/10/2015 RENDU PLATEAU CYTO 193
12/10/2015 RENDU PLATEAU FISH 6
12/10/2015 RENDU PLATEAU Microscopie Electr 0



En résumé, ajouter les étapes "RENDU PLATEAU IF/PF/HE" et "RENDU PLATEAU Microscopie Electr" avec une valeur à "0" dans la 3ème colonne quand elles sont absentes de l'import.


PS : c'est une requête par semaine, donc ce qui est vrai pour le lundi 12 sera vrai pour les 4 jours restants.

Merci pour votre aide, au bout de 2 jours passés dessus je craque.



A voir également:

5 réponses

Réponse 1 / 5
Frenchie83 Messages postés 2240 Date d'inscription   Statut Membre Dernière intervention   338
 
Bonjour
Essayez ceci
https://www.cjoint.com/c/EJyhIhgjaOw
Cdlt
0
LionelLAVERGNE Messages postés 4 Date d'inscription   Statut Membre Dernière intervention  
 
Salutations, merci beaucoup mais en fait il y a 3 "param"

Param1 = "RENDU PLATEAU IF/PF/HE"
Param2 = "RENDU PLATEAU Microscopie Electr"
Param3 = "RENDU PLATEAU FISH" (oublié dans l'exemple)

J'ai essayé de faire la correction par moi même je n'y arrive pas.

Merci pour le coup de main d'avance, je suis quasiment arrivé à résoudre mon problème grâce à toi
Merci+++
0
Réponse 2 / 5
Frenchie83 Messages postés 2240 Date d'inscription   Statut Membre Dernière intervention   338
 
Bonjour
Voici avec le 3ème paramètre 
Option Compare Text

Sub Controle()
    Application.ScreenUpdating = False
    Param1 = "RENDU PLATEAU IF/PF/HE"
    Param2 = "RENDU PLATEAU Microscopie Electr"
    Param3 = "RENDU PLATEAU FISH"
    Param = Param1
    DateJour = [A2]
    
Deb:
    Set c = Columns("B").Find(Param, LookIn:=xlValues)
    If c Is Nothing Then
        Range("A" & [A10000].End(xlUp).Row + 1).Value = DateJour
        Range("B" & [A10000].End(xlUp).Row).Value = Param
        Range("C" & [A10000].End(xlUp).Row).Value = 0
    End If
    
    If Param = Param3 Then Exit Sub
    If Param = Param2 Then Param = Param3
    If Param = Param1 Then Param = Param2
    GoTo Deb
End Sub

Cdlt
0
LionelLAVERGNE Messages postés 4 Date d'inscription   Statut Membre Dernière intervention  
 
Merci ça fonctionne. Maintenant dernier problème.
Cette macro marche pour un jour donnée or j'en ai 5 (semaine de travail) sur ma feuille EXCEL exportée du soft.

2 possibilités:
1- séparer chaque jour sur un nouvel onglet et lancer cette macro.
PB --> Comment séparer par jour sachant que la date change chaque semaine?
2- modifier cette même macro pour quelle s'applique par date
PB --> Je n'ai pas la moindre idée de comment faire.

Dans tous les cas merci beaucoup pour le coup de main!
0
Réponse 3 / 5
Frenchie83 Messages postés 2240 Date d'inscription   Statut Membre Dernière intervention   338
 
Bonjour
Voici, dans la restitution, j'insère une ligne vide entre chaque changement de date.
A tester. 
Option Compare Text

Sub Controle()
    Application.ScreenUpdating = False
    Dim Param1Trouve As Boolean, Param2Trouve As Boolean, Param3Trouve As Boolean
    Dim Param1 As String, Param2 As String, Param3  As String
    Dim DerLig As Integer
    
    Param1 = "RENDU PLATEAU IF/PF/HE"
    Param2 = "RENDU PLATEAU Microscopie Electr"
    Param3 = "RENDU PLATEAU FISH"
    
    DerLig = [A100000].End(xlUp).Row
    For j = DerLig To 2 Step -1
        DateJour = Cells(j, 1)
        If Cells(j, 2) = Param1 Then Param1Trouve = True
        If Cells(j, 2) = Param2 Then Param2Trouve = True
        If Cells(j, 2) = Param3 Then Param3Trouve = True
        If Cells(j, 1) <> Cells(j - 1, 1) Then
            For k = 1 To 4
                Rows(j).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Next k
            If Param1Trouve = False Then
                Cells(j + 1, 1) = DateJour
                Cells(j + 1, 2) = Param1
                Cells(j + 1, 3) = 0
                If Param2Trouve = False Then
                    Cells(j + 2, 1) = DateJour
                    Cells(j + 2, 2) = Param2
                    Cells(j + 2, 3) = 0
                    If Param3Trouve = False Then
                        Cells(j + 3, 1) = DateJour
                        Cells(j + 3, 2) = Param3
                        Cells(j + 3, 3) = 0
                    End If
                End If
            End If
        End If
    Next j
    DerLig = [A100000].End(xlUp).Row
    For i = DerLig To 2 Step -1
        If Cells(i, 1) = "" And Cells(i - 1, 1) = "" Then Cells(i, 1).EntireRow.Delete
        If Cells(i, 1) = "" And Cells(i + 1, 1) = Cells(i - 1, 1) Then Cells(i, 1).EntireRow.Delete
    Next i
    If Cells(2, 1) = "" Then Cells(2, 1).EntireRow.Delete
End Sub

Cdlt
0
LionelLAVERGNE Messages postés 4 Date d'inscription   Statut Membre Dernière intervention  
 
Nombreuses lignes apparaissent en doublon.

Lundi :

Date Etape Nombre Type
19/10/2015 MISE EN CASSETTE 883 Blocs
19/10/2015 MISE EN HYPERCENTRE 855 Blocs
19/10/2015 INCLUSION 754 Blocs
19/10/2015 COUPE 804 Blocs
19/10/2015 RENDU PLATEAU MORPHO 989 Lames
19/10/2015 RENDU PLATEAU IHC 332 Lames
19/10/2015 RENDU PLATEAU IF/PF/HE 67 Lames
19/10/2015 RENDU PLATEAU IF/PF/HE 0
19/10/2015 RENDU PLATEAU Microscopie Electr 0
19/10/2015 RENDU PLATEAU FISH 0
19/10/2015 RENDU PLATEAU CYTO 61 Lames

Mardi
Date Etape Nombre Type
20/10/2015 MISE EN CASSETTE 925 Blocs
20/10/2015 MISE EN HYPERCENTRE 836 Blocs
20/10/2015 INCLUSION 841 Blocs
20/10/2015 COUPE 768 Blocs
20/10/2015 RENDU PLATEAU MORPHO 881 Lames
20/10/2015 RENDU PLATEAU IHC 234 Lames
20/10/2015 RENDU PLATEAU IF/PF/HE 0
20/10/2015 RENDU PLATEAU Microscopie Electr 0
20/10/2015 RENDU PLATEAU FISH 0
20/10/2015 RENDU PLATEAU CYTO 202 Lames
20/10/2015 RENDU PLATEAU IF/PF/HE 0
20/10/2015 RENDU PLATEAU Microscopie Electr 0
20/10/2015 RENDU PLATEAU FISH 0
20/10/2015 RENDU PLATEAU FISH 12 Lames

Mercredi
Date Etape Nombre Type
21/10/2015 MISE EN CASSETTE 693 Blocs
21/10/2015 MISE EN HYPERCENTRE 673 Blocs
21/10/2015 INCLUSION 830 Blocs
21/10/2015 COUPE 718 Blocs
21/10/2015 RENDU PLATEAU MORPHO 1003 Lames
21/10/2015 RENDU PLATEAU IHC 440 Lames
21/10/2015 RENDU PLATEAU IF/PF/HE 228 Lames
21/10/2015 RENDU PLATEAU IF/PF/HE 0
21/10/2015 RENDU PLATEAU Microscopie Electr 0
21/10/2015 RENDU PLATEAU FISH 0
21/10/2015 RENDU PLATEAU CYTO 121 Lames


Jeudi
Date Etape Nombre Type
22/10/2015 MISE EN CASSETTE 855 Blocs
22/10/2015 MISE EN HYPERCENTRE 822 Blocs
22/10/2015 INCLUSION 601 Blocs
22/10/2015 COUPE 861 Blocs
22/10/2015 RENDU PLATEAU MORPHO 1011 Lames
22/10/2015 RENDU PLATEAU IHC 386 Lames
22/10/2015 RENDU PLATEAU IF/PF/HE 103 Lames
22/10/2015 RENDU PLATEAU IF/PF/HE 0
22/10/2015 RENDU PLATEAU Microscopie Electr 0
22/10/2015 RENDU PLATEAU FISH 0
22/10/2015 RENDU PLATEAU CYTO 179 Lames
22/10/2015 RENDU PLATEAU IF/PF/HE 0
22/10/2015 RENDU PLATEAU Microscopie Electr 0
22/10/2015 RENDU PLATEAU FISH 0
22/10/2015 RENDU PLATEAU FISH 9 Lames


Vendredi
Date Etape Nombre Type
23/10/2015 MISE EN CASSETTE 829 Blocs
23/10/2015 MISE EN HYPERCENTRE 797 Blocs
23/10/2015 INCLUSION 759 Blocs
23/10/2015 COUPE 890 Blocs
23/10/2015 RENDU PLATEAU MORPHO 1037 Lames
23/10/2015 RENDU PLATEAU IHC 430 Lames
23/10/2015 RENDU PLATEAU IF/PF/HE 0
23/10/2015 RENDU PLATEAU Microscopie Electr 0
23/10/2015 RENDU PLATEAU FISH 0
23/10/2015 RENDU PLATEAU CYTO 170 Lames
23/10/2015 RENDU PLATEAU IF/PF/HE 0
23/10/2015 RENDU PLATEAU Microscopie Electr 0
23/10/2015 RENDU PLATEAU FISH 0
23/10/2015 RENDU PLATEAU FISH 58 Lames
0
Réponse 4 / 5
Frenchie83 Messages postés 2240 Date d'inscription   Statut Membre Dernière intervention   338
 
Ne connaissant pas la structure de votre fichier, j'ai été obligé de le créer d'après votre description, cependant, pour une question de commodité, il me serait plus facile d'avoir un extrait de votre fichier excel, nous gagnerions du temps et serions sûrs que cela fonctionnerait correctement.
Pour joindre votre fichier, allez sur www.cjoint.com, copiez le lien créé et coller ici dans votre prochaine réponse.
Merci
0
LionelLAVERGNE Messages postés 4 Date d'inscription   Statut Membre Dernière intervention  
 
https://www.cjoint.com/c/EJDmVEw3Ef7

Merci pour le lien
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 5
Frenchie83 Messages postés 2240 Date d'inscription   Statut Membre Dernière intervention   338
 
Voici,
Petite remarque, dans votre fichier, feuille "Import", l'étape "RENDU PLATEAU FISH" contient 2 espaces entre PLATEAU et FISH, j'en ai donc tenu compte dans la phrase suivante:
Param3 = "RENDU PLATEAU FISH 

Sub Controle()
    Application.ScreenUpdating = False
    Dim Param1Trouve As Boolean, Param2Trouve As Boolean, Param3Trouve As Boolean
    Dim Param1 As Variant, Param2 As Variant, Param3  As Variant
    Dim DerLig As Integer
    
    Param1 = "RENDU PLATEAU IF/PF/HE"
    Param2 = "RENDU PLATEAU Microscopie Electr"
    Param3 = "RENDU PLATEAU  FISH"
    
    DerLig = [A100000].End(xlUp).Row
    
    Range("A1").Select
    ActiveWorkbook.Worksheets("Import").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Import").Sort.SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Import").Sort
        .SetRange Range("A1:D" & DerLig)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    For j = DerLig To 2 Step -1
        DateJour = Cells(j, 1)
        If Cells(j, 2) = Param1 And Cells(j, 1) = DateJour Then Param1Trouve = True   '"RENDU PLATEAU IF/PF/HE"
        If Cells(j, 2) = Param2 And Cells(j, 1) = DateJour Then Param2Trouve = True   '"RENDU PLATEAU Microscopie Electr"
        If Cells(j, 2) = Param3 And Cells(j, 1) = DateJour Then Param3Trouve = True   '"RENDU PLATEAU  FISH"
        If Cells(j, 1) <> Cells(j - 1, 1) Then
            For k = 1 To 4
                Rows(j).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Next k
            If Param1Trouve = False Then
                Cells(j + 1, 1) = DateJour
                Cells(j + 1, 2) = Param1
                Cells(j + 1, 3) = 0
            End If
            If Param2Trouve = False Then
                Cells(j + 2, 1) = DateJour
                Cells(j + 2, 2) = Param2
                Cells(j + 2, 3) = 0
            End If
            If Param3Trouve = False Then
                Cells(j + 3, 1) = DateJour
                Cells(j + 3, 2) = Param3
                Cells(j + 3, 3) = 0
            End If
            Param1Trouve = False
            Param2Trouve = False
            Param3Trouve = False
        End If
    Next j
    DerLig = [A100000].End(xlUp).Row
    For i = DerLig To 2 Step -1
        If Cells(i, 1) = "" And Cells(i - 1, 1) = "" Then Cells(i, 1).EntireRow.Delete
        If Cells(i, 1) = "" And Cells(i + 1, 1) = Cells(i - 1, 1) Then Cells(i, 1).EntireRow.Delete
    Next i
    If Cells(2, 1) = "" Then Cells(2, 1).EntireRow.Delete
End Sub


Cdlt
0

Discussions similaires

Message d'erreur "Pas de module CI"
KinderJustine -
Gelouk -

3 réponses
Tableau croisé dynamique - absence de certaines données
crazyrider71 -
Hana -

4 réponses