Boucle sur feuilles au format date "dd mm yy" à modifier

[cibleo]

Bonjour le forum,

Le code placé dans le formulaire "Synthese" (Private Sub CommandButton1_Click())fonctionne et me permet d'effectuer une recherche dans toutes les feuilles (au format date) à partir d'un nom sélectionné dans la ComboChauffeurs.

Le report s'effectue alors dans la feuille de calcul "Synthese".

Dans ce formulaire, je dois donc opérer 2 choix :

- le nom du chauffeur (ça marche)
- le mois qui doit me permettre de sélectionner les feuilles de calcul à traiter (je demande votre aide, je ne sais pas faire)

Dans 1 premier temps, j'aimerais donc reporter les noms des feuilles (des dates) que je vais traiter : dans la colonne A à partir de A2 Feuille de calcul "Synthese".

Puis j'aimerais pouvoir sélectionner ,à l'aide de la ComboMois, les feuilles à traiter.

Exemple : je choisis 01 et ce sont toutes les feuilles de mon classeur nommées 01 01 09, 02 01 09, 05 01 09 etc... qui devront être traiter.

Idem pour les autres mois.

Dans le code présenté, toutes les feuilles sont traitées, pouvez-vous m'aider à modifier ce code ?

.../...
For Each Ws In ThisWorkbook.Worksheets
    With Ws
    If IsDate(Ws.Name) Then
.../...

Cibleo

 

[jp14]

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonsoir

Un code à tester

Sheets(£nomfeuille).Range("b" & Cel.Row & ":L" & Cel.Row).Copy Destination:=ShtR.Cells(DerLiR, 2)

Bonne soirée

JP

 

[cibleo]

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonsoir le forum,
Bonsoir JP14,

C'est OK pour la modification

Feuille "Synthese", colonnes M,N,O et P je saisis des horaires manuellement au format hh:mm

Dans l'événement "Initialize"du formulaire, j'ai donc rajouté une ligne d'instructions pour formater ces colonnes.

J'aimerais aussi formater les colonnes Q,R,S et T au format [hh:mm] puisqu'il s'agit de durée.

Or j'ai un message d'erreur sur le NumberFormat, on dirait qu'il n'accepte pas le [hh:mm]

ShtR.Range("M2:P" & DerLiR).NumberFormat = "hh:mm"
[B][COLOR=red]ShtR.Range("Q2:T" & DerLiR).NumberFormat = "[hh:mm[/COLOR][COLOR=red]]"[/COLOR][/B]

Comment contourner le problème ?

S'agit -il du même problème soulevé dans ce fil ?

https://www.excel-downloads.com/threads/format-heures-dans-textbox.131445/

Pour info, j'ai rajouté dans la boucle Do Loop ta modif en vert + les 2 instructions en bleu qui sont les formules en colonne Q et T.

.../...
          Do
            DerLiR = DerLiR + 1
            'Range(Cells(Cel.Row, 2), Cells(Cel.Row, 12)).Copy ShtR.Cells(DerLiR, 2)
            [COLOR=darkgreen]Sheets(£nomfeuille).Range("b" & Cel.Row & ":L" & Cel.Row).Copy Destination:=ShtR.Cells(DerLiR, 2)[/COLOR]
            ShtR.Cells(DerLiR, 1) = Format(£nomfeuille, "ddd dd mmm yy")
            [COLOR=blue]ShtR.Cells(DerLiR, 17).FormulaR1C1 = "=RC[-1]-RC[-4]"[/COLOR]
[COLOR=blue]ShtR.Cells(DerLiR, 20).FormulaR1C1 = "=RC[-3]*0.85-RC[-2]-RC[-1]"[/COLOR]
 
            Set Cel = .FindNext(Cel)
          Loop While Not Cel Is Nothing And Adrdeb <> Cel.Address
.../...

A+ Cibleo

 

[ChTi160]

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Salut cibleo
bonjour le fil
Bonjour le forum


Pour ce qui est du format des heures supérieures à 24
ceci semble fonctionner.

ShtR.Range("Q2:T" & DerLiR).NumberFormat = "[COLOR=Red][[/COLOR]hh[COLOR=Red]][/COLOR]:mm"

Bonne journée

 

[cibleo]

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonsoir le forum,
Bonsoir JP14 et bienvenue sur le fil ChTi160,

Merci pour la réponse, par moment j'y suis vraiment plus

Comme vous le voyez, j'ai rajouté une textbox dans laquelle je dois saisir un mot (une chaine de caractères).



Selon la même structure que le code ci-dessous, j'aimerais donc créé une seconde macro qui effectuerait une recherche dans la plage (B4:L11) du mot saisi.

En fait, je souhaite faire un choix dans le formulaire : rechercher soit par mot (TextBox1) ou soit par chauffeurs (ComboChauffeurs) mais pas les 2 à la fois.

Private Sub remplirsynthese(£nomfeuille As Variant, VSearch As String)
Dim plage As Range, Cel As Range, Adrdeb As String
With Sheets(£nomfeuille)
    [COLOR=red][B]Set plage = .Range("B4:L11")[/B][/COLOR]
    With plage
      Set Cel = .Find(VSearch, LookAt:=xlPart)
      If Not Cel Is Nothing Then
      trouve = True
          Adrdeb = Cel.Address
          Do
.../...

Dans le fichier joint, j'ai placé le mot "Dupont" dans différentes cellules des feuilles de janvier et créé une feuille "Résultat souhaité" pour bien visualiser ce que j'aimerais obtenir.

(J'ai mis des couleurs pour la compréhension)

Comment faire pour que la boucle parcourt les cellules de la plage B4:L11 progressivement de gauche à droite puis de haut en bas pour obtenir le résultat souhaité.

Je sais que cela ne doit pas être simple à réaliser puisque seules les cellules concernées doivent être recopiées et non la plage entière comme dans le code initial.

Merci de votre aide

A+ Cibleo

 

[cibleo]

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonsoir à tous,
Bonsoir JP14

Par rapport au code initial de JP14, j'ai changé ce qui est surligné en rouge ci dessous.

J'ai saisi le mot "dupont" dans la TextBox1 et choisi "01" dans la ComboMois puis j'ai lancer la recherche.

Le résultat de la recherche se trouve dans la feuille "Synthese" et ce que j'aimerais obtenir se situe dans la feuille "Résultat souhaité"

Comment dois-je modifier l'instruction en Bleu ci-dessous.

Dans ce cas précis, je ne souhaite recopier que la cellule dans laquelle figure le mot saisi et non la plage entière.

Private Sub CommandButton1_Click()
  Dim VSearch As String
  Dim plage As Range, Cel As Range, Adrdeb As String
  Dim premier As Boolean, dernier As Boolean
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  [COLOR=red]If TextBox1.Value = "" Then[/COLOR]
    Call MsgBox("Quel est le nom que je dois chercher ?" _
                & vbCrLf & "" _
                , vbInformation, "Problème de mémoire")
 
    Exit Sub
  End If
  [COLOR=red]VSearch = Me.TextBox1.Value[/COLOR]
  DerLiR = 1
.../...

Private Sub remplirsynthese(£nomfeuille As Variant, VSearch As String)
Dim plage As Range, Cel As Range, Adrdeb As String
With Sheets(£nomfeuille)
    [COLOR=red]Set plage = .Range("B4:L11")[/COLOR]
    With plage
      Set Cel = .Find(VSearch, LookAt:=xlPart)
      If Not Cel Is Nothing Then
      trouve = True
          Adrdeb = Cel.Address
          Do
            DerLiR = DerLiR + 1
            'Range(Cells(Cel.Row, 2), Cells(Cel.Row, 12)).Copy ShtR.Cells(DerLiR, 2)
            ShtR.Cells(DerLiR, 1) = Format(£nomfeuille, "ddd dd mmm yy")
            Sheets(£nomfeuille).Range("A" & Cel.Row).Copy Destination:=ShtR.Cells(DerLiR, 2)
            [COLOR=navy]Sheets(£nomfeuille).Range("B" & Cel.Row & ":L" & Cel.Row).Copy Destination:=ShtR.Cells(DerLiR, 3)[/COLOR]
.../...

Pouvez-vous m'aiguiller à nouveau ?

J'ai remplacé le fichier ci-dessus.

Cibleo

PS : les couleurs c'est pour bien visualiser le problème, ne pas en tenir compte.

 

[cibleo]

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonjour le forum,
Bonjour JP14,

Je continue mes recherches sur le forum car je dois l'avouer : je suis dans une impasse

Dans ce cas précis, ne faut-il pas intégrer Exit do dans la boucle ?

'on sort de la boucle pour passer à la cellule suivante
        Exit Do

Cibleo

 

[jp14]

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonjour

Pour faire simple

Private Sub TextBox1_Change()
If TextBox1.SelStart > 0 Then
Me.ComboChauffeurs.Visible = False
Me.ComboMois.Visible = False
Me.Label1.Visible = False
Me.Label2.Visible = False
Else
Me.ComboChauffeurs.Visible = True
Me.ComboMois.Visible = True
Me.Label1.Visible = True
Me.Label2.Visible = True


End If
End Sub

Ce code permet de cacher les éléments qui ne sont pas utiles

Private Sub CommandButton1_Click()
  Dim VSearch As String
  Dim plage As Range, Cel As Range, Adrdeb As String
  Dim premier As Boolean, dernier As Boolean
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  Select Case Me.ComboChauffeurs.Visible
  
    Case True
       code existant
    Case False
      Code à écrire pour chercher le texte
    End Select

Cette technique permet de séparer les deux codes.


JP

 

[jp14]

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonjour

Ci joint le fichier avec les deux techniques de recherche.

A tester


JP

 

[cibleo]

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonsoir le forum,
Bonsoir jp14

Epoustouflant, je suis scotché par la rapidité de cette macro de recherche, c'est fulgurant

C'est du travail d'orfèvre

Je vais imprimer tout cela pour l'analyser à tête reposée.

En attendant, pour peaufiner le résultat de la recherche avec la TextBox1, j'aimerais ne faire apparaitre que les cellules qui contiennent le mot recherché.

Dans la procédure "remplirsynthese2", après la boucle Do loop, ne peut-on pas intégrer des instructions afin d'effacer les cellules ne contenant pas le mot saisi dans textbox1.

Comme illustré ci-dessous, j'ai fait une recherche avec le mot "dupont et j'aimerais que les cellules marquées d'une croix n'apparaissent pas.

Est-ce possible ?



Je ne sais vraiment pas comment te remercier.

Difficile de poster avec le vent et la pluie aujourd'hui, problème de wifi.

Cibleo

 

[jp14]

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonsoir

Ci dessous le code à rajouter

Private Sub remplirsynthese2(£nomfeuille As Variant, VSearch As String)
.......................................
 With ShtR
 Set plage = .Range("c2:u" & .Range("a65536").End(xlUp).Row)
 
 For Each Cel In plage
    If Cel <> "" And InStr(Cel.Value, VSearch) = 0 Then Cel.Value = ""
 Next Cel
 
 End With
 
End Sub

A tester

JP

 

[cibleo]

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonjour à tous,
Bonjour jp14,

Je ne sais pas ce que je fabrique mais ça ne fonctionne pas

En reprenant la structure de ton code comme ci-dessous, ça fonctionne.

 With ShtR
 Set plage = .Range("c2:u" & .Range("a65536").End(xlUp).Row)
 
 For Each Cel In plage
     If Not Cel.Value Like "*Dupont*" Then
     Cel.Value = ""
     End If
 Next Cel
 
 End With

Mais parce que j'ai précisé le mot "dupont" dans le code, sinon c'est la valeur inscrite dans textbox1 que j'aimerais préciser.

A+ cibleo

 

[jp14]

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonsoir

J'ai testé avec ce code, la procédure fonctionne correctement.

 For Each Cel In plage
     If Not (Cel.Value Like "*" & TextBox1.Value & "*") Then
     Cel.Value = ""
     End If
 Next Cel

A+

JP

 

[cibleo]

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonjour à tous,
Bonjour jp14

Ok, c'est tout bon, mais il faut que je respecte la casse.

Sinon, je teste ceci ci-dessous sans respecter la casse, cela a l'air de fonctionner.

With ShtR
 Set plage = .Range("c2:m" & .Range("a65536").End(xlUp).Row)
 
 For Each Cel In plage
         If InStr(UCase(Cel.Value), UCase(VSearch)) = 0 Then Cel.Value = ""
         End If
 Next Cel
 
 End With

Par contre, j'ai un nouveau petit souci de mise en forme :

S'il n'y a pas de trace du mot recherché ou s'il n'y a qu' 1 occurence trouvée, cela m'efface les en-têtes de C à M. (précède aussi une erreur d'éxécution).

Comme illustré, le mot "cerise" ne figurait qu'une seule fois dans les feuilles de janvier, ma ligne d'entêtes de C à M s'est alors effacée



Peux-tu à nouveau te pencher sur ce problème ?

A+ Cibleo

 

[jp14]

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonjour

Concernant ce point

Bonjour à tous,
Bonjour jp14

Ok, c'est tout bon, mais il faut que je respecte la casse.

Sinon, je teste ceci ci-dessous sans respecter la casse, cela a l'air de fonctionner.


A+ Cibleo

Find par défaut ne considère pas la casse.

Extrait de la documentation.
MatchCase Argument de type Variant facultatif. Affectez-lui la valeur True pour que la recherche respecte la casse. La valeur par défaut est False.

Je n'avais pas de problème car j'écrivais "Dupon"


Code à écrire chaque fois que l'on définit la valeur de DerLiR comme par exemple

DerLiR = .Range("a65536").End(xlUp).Row

If DerLiR = 1 Then DerLiR = 2

JP