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

Résolu
Lionel -  
Frenchie83 Messages postés 2254 Statut Membre -
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.

5 réponses

  1.
    Frenchie83 Messages postés 2254 Statut Membre 339
     
    Bonjour
    Essayez ceci
    https://www.cjoint.com/c/EJyhIhgjaOw
    Cdlt
    0
    1. LionelLAVERGNE Messages postés 4 Statut Membre
       
      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
  2. Frenchie83 Messages postés 2254 Statut Membre 339
     
    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
    1. LionelLAVERGNE Messages postés 4 Statut Membre
       
      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
  3. Frenchie83 Messages postés 2254 Statut Membre 339
     
    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
    1. LionelLAVERGNE Messages postés 4 Statut Membre
       
      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
  4. Frenchie83 Messages postés 2254 Statut Membre 339
     
    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

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

    Posez votre question
  6. Frenchie83 Messages postés 2254 Statut Membre 339
     
    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

mettre des lignes sur des pages word pour des prises de notes
hm -
m@rina -

3 réponses
Excel : afficher toutes les lignes et colonnes masquées
livlarsen -
Mehdiiii -

27 réponses