Bonjour le forum je sollicite votre imagination

[Andrew47]

Bonjour après plusieurs jours et plusieurs tentative je sollicite votre savoir. Je suis à essayer de faire un fichier de suivie de travaux, pour mon emploi. J'ai essayer de trouver sur le forum des pistes pour me fabriquer un outil de suivie mais il y a toujours quelque choses qui cloche. Voici le topos, je prend une liste de Bon de travail avec descriptions à partir du logiciel d'entretien en format Excel, je doit faire un planning hebdomadaire pour différents métiers avec un suivie journalier (entré du temps pour chaque bon de travail). J'ai beaucoup travailler avec des formules, que je suis assez à l'aise avec sans trop de succès, je crois que ce serais préférable en VBA, mais mes connaissances sont très limité dans ce domaine, je comprend le principe et j'arrive à faire des choses simple, mais là c'est au dela de mes possibilités. Si il ya des membres qui veulent si attaquer j'apprécierais d'avoir des notes explicative pour savoir comment faire et continuer le travail moi-même. Je joint un fichier, je repart à zéro avec vous mon travail à date ne me satisfaisant pas du tout. Je sais que je demande beaucoup, je joint un fichier et je répondrai aux questions, si ce n'est pas clair.
Merci à l'avance.
Andrew

 

[porcinet82]

Re : Bonjour le forum je sollicite votre imagination

Salut,

Je viens de jeter un oeil a ton fichier qui est assez clair. Par contre, tu n'as pas mis d'exemple de ce que devais faire la macro, du coup, je ne savais pas trop faire. Quelles infos mettrent dans quelles colonnes ???

En attendant quelques info supplémentaires...

@+

 

[Andrew47]

Re : Bonjour le forum je sollicite votre imagination

Bonjour romain, ce que j'essaie de faire c'est que les données de la DATA feuille ce copie dans les autres feuilles mais ils doivent s'incéré entre les lignes de chaques feuilles en fonction du métier (colonne "E" Data), ensuite ce trier entre les différents type d'entretien (colonne "L" Data). Les formules pour la compilation doit suivre, j'espère être assez clair. Sinon je vais essayer de te retourner le fichier avec plus d'explication.

 

[porcinet82]

Re : Bonjour le forum je sollicite votre imagination

Salut,

Tu as remis le meme fichier que sur le premier post !!!
En fait, j'aurai souhaité un exemple, par exemple que tu remplisses 2 ou 3 lignes afin que je vois ou se placeront les colonnes de la feuille data et ce qui va dans les colonne lundi à dimanche...

@+

 

[smotty]

Re : Bonjour le forum je sollicite votre imagination

Bonjour à tous,

J'ai regardé vite fait mais si j'ai bien compris, la solution se trouve du coté des tableaux croisés dynamiques. Ce qui permet d'avoir une sélection de données selon les critères choisis.

 

[Andrew47]

Re : Bonjour le forum je sollicite votre imagination

Salut,

Tu as remis le meme fichier que sur le premier post !!!
En fait, j'aurai souhaité un exemple, par exemple que tu remplisses 2 ou 3 lignes afin que je vois ou se placeront les colonnes de la feuille data et ce qui va dans les colonne lundi à dimanche...

@+

OK j'ai mis des exemples désoler de n'y avoir pas penser, plustôt et j'espère que ça iras. Dans les collones de Lundi à Dimanche cela vas être mon suivie journalier, je vais inscrire chaque jour le temps effectuer sur chaque Bon de travail.

Merci de ta patience

 

[smotty]

Re : Bonjour le forum je sollicite votre imagination

Bonsoir Andrew47 , le Forum,

Voici ton fichier avec du VBA à compléter en worksheet DATA.

Le principal est fait.

Je m'étais un peu trop avancé en parlant de tableau croisé dynamique.😀

Je me suis permis de "défusionner les cellules titres contenant les types de métier. c'était plus facile pour une rechercher automatique. 😛

Bref, ça fonctionne pour les éléments à placer dans la feuille sur les électriciens, reste à compléter la fonction qui détermine la feuille concernée.

 

[smotty]

Re : Bonjour le forum je sollicite votre imagination

Je n'arrive pas à joindre le fichier donc voici le code à mettre en sheet(DATA):

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range

'*************************************************
'détecte une sélection
'*************************************************
If Not Intersect(Range("A:A"), Target) Is Nothing Then
Set R = Intersect(Range("A:A"), Target)
If UCase(R.Value) = "X" Then
'********************************************************
'appelle la procédure qui copie les infos aux bon endroit
'********************************************************
Call selectionner(R)
End If
End If
End Sub

Sub selectionner(ByVal Cell As Range)
Dim StrMetier As String
Dim StrRech As String
Dim Champs As Range
Dim C As Range

'*********************************
'type de travail
'*********************************
StrRech = Cell.Offset(0, 12).Value

'*********************************
'métier
'*********************************
StrMetier = Cell.Offset(0, 5).Value
With FeuilleCible(StrMetier)
Set Champs = .Range("D😀")
Set C = Champs.Find(StrRech)
If Not C Is Nothing Then
'************************************
'détecte la ligne où copier les infos
'************************************
l = C.End(xlDown).Row + 1

'************************************************************************
'assure un espace entre la dernière ligne et le type de travail suivant
'************************************************************************
If C.Offset(1, 0).Value <> "" Then .Rows(l).Insert shift:=xlDown
'
.Cells(l, 1).Value = Cell.Offset(0, 1).Value
.Cells(l, 2).Value = Cell.Offset(0, 2).Value
.Cells(l, 3).Value = Cell.Offset(0, 3).Value
.Cells(l, 4).Value = Cell.Offset(0, 4).Value
'
'etc.....
'
End If
End With
End Sub

Function FeuilleCible(ByVal StrMetier As String) As Worksheet
Select Case StrMetier
Case "003-Elec.Surf./Electr. Surf."
Set FeuilleCible = Worksheets(1)
Case "014-Plombier / Plumber"
Set FeuilleCible = Worksheets(3)

'*** à compléter *********

End Select
End Function

Je te laisse terminer le code, le plus dur est fait 😀

En espérant que ça t'aidera

Cordialement

 

[Andrew47]

Re : Bonjour le forum je sollicite votre imagination

Bonjour Smoty je vais essayer et je te reviens plustard, je te remercie.

 

[smotty]

Re : Bonjour le forum je sollicite votre imagination

La taille du fichier était trop grande

J'ai du enlever des données.

 

[Andrew47]

Re : Bonjour le forum je sollicite votre imagination

Merci Smotty, je vais plancher dessus...

 

[Andrew47]

Re : Bonjour le forum je sollicite votre imagination

Rebonjour Smotty, j'ai essayer le code que tu m'as fournis et je l'ai testé. Il copie lorsque je mets un "X" mais écrase la donné lorsque j'en mets un autres. Et ma difficulté c'est d'incérer les données selon la tâche (préventif,correctif ou urgent). Peut-être ce n'est possible étant donné que dans les feuilles de métier je doit inscrire des heures (Dans les collones du Lundi, mardi.., après avoir choisi les travaux à effectuer. L'autre difficulté c'est que les collones dans le fichier Data que je veux copier sont les collones avec les cellules en "jaune" (remarque que j'ai toujours la possibilté de les effacées avant des selectionné).
Merci pour l'aide

 

[smotty]

Re : Bonjour le forum je sollicite votre imagination

Encore moi, bonjour à tous

Voici un correctif pour éviter que les données s'écrasent.

Pour le reste je n'aurai pas le temps de le résoudre, je dois partir.

Sub selectionner(ByVal Cell As Range)
Dim StrMetier As String
Dim StrRech As String
Dim Champs As Range
Dim C As Range

'*********************************
'type de travail
'*********************************
StrRech = Cell.Offset(0, 12).Value

'*********************************
'métier
'*********************************
StrMetier = Cell.Offset(0, 5).Value
With FeuilleCible(StrMetier)
Set Champs = .Range("D😀")
Set C = Champs.Find(StrRech)
If Not C Is Nothing Then
'************************************
'détecte la ligne où copier les infos
'************************************
If C.Offset(1, 0).Value <> "" Then
l = C.End(xlDown).Row + 1
Else
l = C.Offset(1, 0).Row
End If

'************************************************************************
'assure un espace entre la dernière ligne et le type de travail suivant
'************************************************************************
If C.Offset(1, 0).Value <> "" Then .Rows(l).Insert shift:=xlDown
'
.Cells(l, 1).Value = Cell.Offset(0, 1).Value
.Cells(l, 2).Value = Cell.Offset(0, 2).Value
.Cells(l, 3).Value = Cell.Offset(0, 3).Value
.Cells(l, 4).Value = Cell.Offset(0, 4).Value
.Cells(l, 5).Value = Cell.Offset(0, 5).Value
.Cells(l, 6).Value = Cell.Offset(0, 6).Value
.Cells(l, 7).Value = Cell.Offset(0, 7).Value
.Cells(l, 8).Value = Cell.Offset(0, 8).Value
.Cells(l, 9).Value = Cell.Offset(0, 9).Value
.Cells(l, 10).Value = Cell.Offset(0, 10).Value
.Cells(l, 11).Value = Cell.Offset(0, 11).Value
.Cells(l, 12).Value = Cell.Offset(0, 12).Value
.Cells(l, 13).Value = Cell.Offset(0, 13).Value
.Cells(l, 14).Value = Cell.Offset(0, 14).Value
.Cells(l, 15).Value = Cell.Offset(0, 15).Value
.Cells(l, 16).Value = Cell.Offset(0, 16).Value
.Cells(l, 17).Value = Cell.Offset(0, 17).Value
.Cells(l, 18).Value = Cell.Offset(0, 18).Value
.Cells(l, 19).Value = Cell.Offset(0, 19).Value
.Cells(l, 20).Value = Cell.Offset(0, 20).Value
.Cells(l, 21).Value = Cell.Offset(0, 21).Value
.Cells(l, 22).Value = Cell.Offset(0, 22).Value
.Cells(l, 23).Value = Cell.Offset(0, 23).Value
.Cells(l, 24).Value = Cell.Offset(0, 24).Value
.Cells(l, 25).Value = Cell.Offset(0, 25).Value
.Cells(l, 26).Value = Cell.Offset(0, 26).Value
.Cells(l, 27).Value = Cell.Offset(0, 27).Value
.Cells(l, 28).Value = Cell.Offset(0, 28).Value
.Cells(l, 29).Value = Cell.Offset(0, 29).Value
.Cells(l, 30).Value = Cell.Offset(0, 30).Value
.Cells(l, 31).Value = Cell.Offset(0, 31).Value
.Cells(l, 32).Value = Cell.Offset(0, 32).Value


'
'etc.....
'
End If
End With
End Sub

Cordialement

 

[smotty]

Re : Bonjour le forum je sollicite votre imagination

dernier message avant de partir.

Ce programme insère bien les données en fonction du type préventif, correctif etc...

 

[ledzepfred]

Re : Bonjour le forum je sollicite votre imagination

bonjour à tous,

histoire d'avoir moins de lignes dans le code :
remplacer les 32 lignes .Cells(l, x).Value = Cell.Offset(0, x).Value par

for x=1 to 32
.Cells(l, x).Value = Cell.Offset(0, x).Value
next x

puisque tes variables sont déclarées (Dim...) ne pas oublier de le faire également pour x

a+