Recherche par encadrement en VBA
Résolu
Owla
-
Owla -
Owla -
Messieurs/Dames Bonjour,
Je réalise un programme VBA de gestion d'une base de données sous Excel, jusque là aucun soucis.
Voici la fonction qui pose problème :
Private Function Interimaire(semaine As Integer, année As Integer) As String
'Afficher le nom des interimaires présents dans une semaine donnée
Dim fintab As Integer, compteur As Integer, compteur2 As Integer
fintab = Compt_ligne
compteur = 21
compteur2 = 4
'MsgBox fintab
Do
If (Worksheets(1).Cells(compteur, "J")) <= ActiveSheet.Range("D3") And (Worksheets(1).Cells(compteur, "K")) >= ActiveSheet.Range("J3") Or ((Worksheets(1).Cells(compteur, "J")) >= ActiveSheet.Range("D3")) And ((Worksheets(1).Cells(compteur, "K")) <= ActiveSheet.Range("J3")) Then
ActiveSheet.Range("C" & compteur2) = Worksheets(1).Range("B" & compteur) + " " + Worksheets(1).Range("C" & compteur)
ActiveSheet.Range("B" & compteur2) = Worksheets(1).Range("M" & compteur)
ActiveSheet.Range("G" & compteur2) = Worksheets(1).Range("J" & compteur)
ActiveSheet.Range("H" & compteur2) = Worksheets(1).Range("K" & compteur)
'Sommme des heures pointées
ActiveSheet.Range("K" & compteur2).FormulaLocal = "=SOMME(D" & compteur2 & ":J" & compteur2 & ")"
'Mise en forme des cellules remplies
With Range("B" & compteur2 & ":U" & compteur2).Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
compteur2 = compteur2 + 1
End If
compteur = compteur + 1
Loop Until compteur = fintab
End Function
Cette fonction recherche par encadrement, en fonction d'une semaine demandée, si des contrats de travail ont été exécutés lors de cette semaine. L'encadrement prend la globalité, mais je me retrouve encore avec des personnes passant au travers du filet...
Worksheets1.Cells( , J) représente les dates d'entrée du salarié
Worksheets1.Cells( , K) représente les dates de sortie du salarié
Activesheet.Cells(D3) représente le premier jour de la semaine demandée
Activesheet.Cells(J3) représente le dernier jour de la semaine demandée
Si quelqu'un pouvait m'aider à perfectionner mon encadrement, je vous en remercierai bien bas :)
Je reste à votre disposition pour plus de renseignements
Je réalise un programme VBA de gestion d'une base de données sous Excel, jusque là aucun soucis.
Voici la fonction qui pose problème :
Private Function Interimaire(semaine As Integer, année As Integer) As String
'Afficher le nom des interimaires présents dans une semaine donnée
Dim fintab As Integer, compteur As Integer, compteur2 As Integer
fintab = Compt_ligne
compteur = 21
compteur2 = 4
'MsgBox fintab
Do
If (Worksheets(1).Cells(compteur, "J")) <= ActiveSheet.Range("D3") And (Worksheets(1).Cells(compteur, "K")) >= ActiveSheet.Range("J3") Or ((Worksheets(1).Cells(compteur, "J")) >= ActiveSheet.Range("D3")) And ((Worksheets(1).Cells(compteur, "K")) <= ActiveSheet.Range("J3")) Then
ActiveSheet.Range("C" & compteur2) = Worksheets(1).Range("B" & compteur) + " " + Worksheets(1).Range("C" & compteur)
ActiveSheet.Range("B" & compteur2) = Worksheets(1).Range("M" & compteur)
ActiveSheet.Range("G" & compteur2) = Worksheets(1).Range("J" & compteur)
ActiveSheet.Range("H" & compteur2) = Worksheets(1).Range("K" & compteur)
'Sommme des heures pointées
ActiveSheet.Range("K" & compteur2).FormulaLocal = "=SOMME(D" & compteur2 & ":J" & compteur2 & ")"
'Mise en forme des cellules remplies
With Range("B" & compteur2 & ":U" & compteur2).Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
compteur2 = compteur2 + 1
End If
compteur = compteur + 1
Loop Until compteur = fintab
End Function
Cette fonction recherche par encadrement, en fonction d'une semaine demandée, si des contrats de travail ont été exécutés lors de cette semaine. L'encadrement prend la globalité, mais je me retrouve encore avec des personnes passant au travers du filet...
Worksheets1.Cells( , J) représente les dates d'entrée du salarié
Worksheets1.Cells( , K) représente les dates de sortie du salarié
Activesheet.Cells(D3) représente le premier jour de la semaine demandée
Activesheet.Cells(J3) représente le dernier jour de la semaine demandée
Si quelqu'un pouvait m'aider à perfectionner mon encadrement, je vous en remercierai bien bas :)
Je reste à votre disposition pour plus de renseignements
A voir également:
- Recherche par encadrement en VBA
- Recherche automatique des chaînes ne fonctionne pas - Guide
- Recherche par image - Guide
- Encadrement page word - Guide
- Je recherche une chanson - Guide
- Fréquence tnt recherche manuelle - Forum TNT / Satellite / Réception
7 réponses
Bonjour,
Sans avoir le contenu des cellules que tu teste c'est pas évident, mais si tu veux tester seulement 2 conditions différentes je pense que tes parenthèses sont mal placées et beaucoups ne sont pa nécessaires.
Essaye avec
A+
Sans avoir le contenu des cellules que tu teste c'est pas évident, mais si tu veux tester seulement 2 conditions différentes je pense que tes parenthèses sont mal placées et beaucoups ne sont pa nécessaires.
Essaye avec
If (Worksheets(1).Cells(compteur, "J") <= ActiveSheet.Range("D3") And _
Worksheets(1).Cells(compteur, "K") >= ActiveSheet.Range("J3")) Or _
(Worksheets(1).Cells(compteur, "J") >= ActiveSheet.Range("D3") And _
Worksheets(1).Cells(compteur, "K") <= ActiveSheet.Range("J3")) Then
A+
Tu dépose ton classeur sur Cijoint.com et tu met le lien sur un poste suivant.
L'expérience instruit plus sûrement que le conseil. (André Gide)
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
L'expérience instruit plus sûrement que le conseil. (André Gide)
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
Voici donc le sujet :
http://www.cijoint.fr/cjlink.php?file=cj201010/cijNb4vvoH.xlsm
(Re)Merci d'avance !
Ps : a noter que par exemple a la semaine 37 de l'année 2010 il manque une personne (donc une erreur dans l'encadrement)
http://www.cijoint.fr/cjlink.php?file=cj201010/cijNb4vvoH.xlsm
(Re)Merci d'avance !
Ps : a noter que par exemple a la semaine 37 de l'année 2010 il manque une personne (donc une erreur dans l'encadrement)
Bonjour Owla, lermite
excusez l'incruste
En fait, une fonction ne renvoie qu'une seule valeur sous le nom de la fonction et ne prend pas en compte les bordures
exemple débile:
Function sante(prenom As Range) As String
sante = prenom & " est malade"
End Function
si tu met cette fonction dans B1 et "toto" dans A1
=sante(A1) te reverra "toto est malade"
Dans ton cas, il faut écrire une macro paramétrée si tu parcours plusieurs semaines eT/ou années, sinon une sous macro "normale"
sub interimaire(semaine, annee)
ton code
end sub
et dans ta macro "header"
...
interimaire 34, 2010
interimaire 45, 2009
Michel
excusez l'incruste
En fait, une fonction ne renvoie qu'une seule valeur sous le nom de la fonction et ne prend pas en compte les bordures
exemple débile:
Function sante(prenom As Range) As String
sante = prenom & " est malade"
End Function
si tu met cette fonction dans B1 et "toto" dans A1
=sante(A1) te reverra "toto est malade"
Dans ton cas, il faut écrire une macro paramétrée si tu parcours plusieurs semaines eT/ou années, sinon une sous macro "normale"
sub interimaire(semaine, annee)
ton code
end sub
et dans ta macro "header"
...
interimaire 34, 2010
interimaire 45, 2009
Michel
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Bonjour michel,
Désolé mais j'ai du mal à faire le rapprochement avec ton post et mon problème. (peut etre que je n'y ai pas compris la même chose)
En fait j'ai bien compris ( du moins je pense) la distinction entre sub (procédure qui ne renvoie donc rien) et function ( fonction qui renvoie qqch).
Là le problème n'est pas que ça vienne d'une fonction, étant donné qu'elle m'apporte les résultats casi complet. Mon soucis provient de l'encadrement du IF. en résumant ce qui se passe sur un exemple :
La personne X a un contrat du 30/06/10 au 12/06/10.
Je demande en semaine 27 qui est présent, X apparait ( semaine du 05/07 au 11/07)
Par contre je demande en semaine 26 qui est présent, X n'apparait pas ( semaine du 28/06 au 04/07). Alors qu'il est présent dans cette semaine du 30/06 au 04/07.
Mon encadrement n'est pas assez correcte/précis et je n'arrive pas à le faire évoluer, d'où mon appel au secours ici.
Désolé mais j'ai du mal à faire le rapprochement avec ton post et mon problème. (peut etre que je n'y ai pas compris la même chose)
En fait j'ai bien compris ( du moins je pense) la distinction entre sub (procédure qui ne renvoie donc rien) et function ( fonction qui renvoie qqch).
Là le problème n'est pas que ça vienne d'une fonction, étant donné qu'elle m'apporte les résultats casi complet. Mon soucis provient de l'encadrement du IF. en résumant ce qui se passe sur un exemple :
La personne X a un contrat du 30/06/10 au 12/06/10.
Je demande en semaine 27 qui est présent, X apparait ( semaine du 05/07 au 11/07)
Par contre je demande en semaine 26 qui est présent, X n'apparait pas ( semaine du 28/06 au 04/07). Alors qu'il est présent dans cette semaine du 30/06 au 04/07.
Mon encadrement n'est pas assez correcte/précis et je n'arrive pas à le faire évoluer, d'où mon appel au secours ici.
en se posant quelques minutes au calme et en réfléchissant à tous les cas j'ai peut etre trouvé la solution :
****ajout d'une agence dans la condition
If agence = (Worksheets(1).Cells(compteur, "N")) And _
((Worksheets(1).Cells(compteur, "J") >= ActiveSheet.Range("D3") And Worksheets(1).Cells(compteur, "J") <= ActiveSheet.Range("J3")) And (Worksheets(1).Cells(compteur, "K") >= ActiveSheet.Range("D3") And Worksheets(1).Cells(compteur, "K") <= ActiveSheet.Range("J3")) Or _
((Worksheets(1).Cells(compteur, "J") >= ActiveSheet.Range("D3") And Worksheets(1).Cells(compteur, "J") <= ActiveSheet.Range("J3")) And Worksheets(1).Cells(compteur, "K") >= ActiveSheet.Range("J3")) Or _
(Worksheets(1).Cells(compteur, "J") <= ActiveSheet.Range("D3") And (Worksheets(1).Cells(compteur, "K") >= ActiveSheet.Range("J3") And Worksheets(1).Cells(compteur, "K") >= ActiveSheet.Range("D3")) Or _
(Worksheets(1).Cells(compteur, "J") <= ActiveSheet.Range("D3") And Worksheets(1).Cells(compteur, "J") >= ActiveSheet.Range("J3")))) Then
****ajout d'une agence dans la condition
If agence = (Worksheets(1).Cells(compteur, "N")) And _
((Worksheets(1).Cells(compteur, "J") >= ActiveSheet.Range("D3") And Worksheets(1).Cells(compteur, "J") <= ActiveSheet.Range("J3")) And (Worksheets(1).Cells(compteur, "K") >= ActiveSheet.Range("D3") And Worksheets(1).Cells(compteur, "K") <= ActiveSheet.Range("J3")) Or _
((Worksheets(1).Cells(compteur, "J") >= ActiveSheet.Range("D3") And Worksheets(1).Cells(compteur, "J") <= ActiveSheet.Range("J3")) And Worksheets(1).Cells(compteur, "K") >= ActiveSheet.Range("J3")) Or _
(Worksheets(1).Cells(compteur, "J") <= ActiveSheet.Range("D3") And (Worksheets(1).Cells(compteur, "K") >= ActiveSheet.Range("J3") And Worksheets(1).Cells(compteur, "K") >= ActiveSheet.Range("D3")) Or _
(Worksheets(1).Cells(compteur, "J") <= ActiveSheet.Range("D3") And Worksheets(1).Cells(compteur, "J") >= ActiveSheet.Range("J3")))) Then
Pardon je corrige il y'a 2 erreurs de signes le bon code est aisni ( et plus lisiblement)
DebCont = Worksheets(1).Cells(compteur, "J")
FinCont = Worksheets(1).Cells(compteur, "K")
AgenceCont = Worksheets(1).Cells(compteur, "N")
If agence = AgenceCont And (((DebCont >= DebSem And DebCont <= FinSem) And (FinCont >= DebSem And FinCont <= FinSem)) Or (DebCont <= DebSem And (FinCont <= FinSem And FinCont >= DebSem)) Or (DebCont <= DebSem And FinCont >= FinSem) Or ((DebCont >= DebSem And DebCont <= FinSem) And FinCont >= FinSem)) Then
DebCont = Worksheets(1).Cells(compteur, "J")
FinCont = Worksheets(1).Cells(compteur, "K")
AgenceCont = Worksheets(1).Cells(compteur, "N")
If agence = AgenceCont And (((DebCont >= DebSem And DebCont <= FinSem) And (FinCont >= DebSem And FinCont <= FinSem)) Or (DebCont <= DebSem And (FinCont <= FinSem And FinCont >= DebSem)) Or (DebCont <= DebSem And FinCont >= FinSem) Or ((DebCont >= DebSem And DebCont <= FinSem) And FinCont >= FinSem)) Then
TON CLASSEUR un peu simplifié et qui fonctionne, du moins d'après mes tests.
A Eviter :
Des fonctions qui ne sont pas nécessaires genre CompteLigne
Des appels répétés aux même cellules d'une même feuille
Employer des "With" plus souvent.
Employer ActiveSheet quand ont connaît de façon certaine l'origine, ça fonctionne quand ont clic sur le bouton mais en cour de test si la page active n'est pas la bonne.. bonjour les dégats.
Ta façon de sélectionner Ouvier.. employer..etc. n'est pas bonne.
A+
Edit : Y faut pas 36 tests de cellules pour y arriver... :DD
L'expérience instruit plus sûrement que le conseil. (André Gide)
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
A Eviter :
Des fonctions qui ne sont pas nécessaires genre CompteLigne
Des appels répétés aux même cellules d'une même feuille
Employer des "With" plus souvent.
Employer ActiveSheet quand ont connaît de façon certaine l'origine, ça fonctionne quand ont clic sur le bouton mais en cour de test si la page active n'est pas la bonne.. bonjour les dégats.
Ta façon de sélectionner Ouvier.. employer..etc. n'est pas bonne.
A+
Edit : Y faut pas 36 tests de cellules pour y arriver... :DD
L'expérience instruit plus sûrement que le conseil. (André Gide)
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
J'essaie de mettre le fichier en pièce jointe mais en fait je ne sais pas comment faire sur le forum ...