Modification de ma macro

Le 28/06/2019 à 16:48

bonjour a tous étant nouveau en excel et connaissant pas du tout les VBA

j'ai trouver une ligne de code qui peux correspondre a mes attentes:

je les modifier en partie, mais des chose je n'arrive pas a modifier d’où une aide.

Sub testcpd()

' wsd = référence de la feuille pointage

Set wsd = Worksheets("pointage")

'dld dernière ligne de la feuille pointage sur base de la colonne A

dld = wsd.Range("G" & Rows.Count).End(xlUp).Row

-ce que je voudrais(cette ligne marche quand meme mais à la base ces sur une base de 7 ligne :G17 à G25)

' wsc référence de la feuille resultat

Set wsc = Worksheets("resultat")

' on recherche dans les colonnes de a à d, la date qui se trouve en G17 sur wsd, on met le résultat dans un range nommé re

Set re = wsc.Range("a:d").Find(wsd.Range("G17"), lookat:=xlWhole)

' si re n'est pas vide = on trouvé

If Not re Is Nothing Then

' on copie la cellule K17

wsd.Range("K17").Copy

' à partir de la cellule en ligne 7 dans la colonne dans laquelle on a trouvé la date

wsc.Cells(7, re.Column).PasteSpecial Paste:=xlValues

-(j aimerais ici)(la valeur trouver ici se colle a la case tout de suite a droite de la date qui correspond)(actuellement en colonne la )

wsd.Range("Q17").Copy

wsc.Cells(8, re.Column).PasteSpecial Paste:=xlValues

-(j aimerais ici)(la valeur trouver ici se colle a la case tout de suite a droite de la valeur du dessus)

End If

End Sub

14pointage-avec-macro-test.xlsm (31.46 Ko)
Le 29/06/2019 à 10:35

Bonjour westcoast320, le forum,

Pourquoi le faire avec macro alors qu'une formule ferait l'affaire ?

A tester via formule...

2pointage-avec-macro-test-2.xlsm (32.25 Ko)

Cordialement,

Le 29/06/2019 à 18:21

Bonjour je regarder sur pc quand je rentre mais a la base je prend pas de formule car la ou je rempli quand je change de semaine du coup j efface les résultats donc sa devrais effacer sur le 2em tableau aussi

Le 30/06/2019 à 08:17

Bonjour westcoast320,

quand je change de semaine du coup j efface les résultats

Un essai par macro....

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim ws1 As Worksheet, ws2 As Worksheet
 Dim i As Long, j As Long, dl As Long

Application.ScreenUpdating = False

Set ws1 = Sheets("pointage")
Set ws2 = Sheets("resultat voulu")

dl = ws2.Range("B" & Rows.Count).End(xlUp).Row

If Not Application.Intersect(Target, ws1.Range("G17:Q23")) Is Nothing Then
 For i = 6 To dl
  For j = 17 To 23
   If ws2.Range("B" & i) Like ws1.Range("G" & j) Then
    ws2.Range("C" & i) = ws1.Range("K" & j)
    ws2.Range("D" & i) = ws1.Range("Q" & j)
   End If
  Next j
 Next i
End If

If Not Application.Intersect(Target, ws1.Range("M13")) Is Nothing Then ws1.Range("K17:P23").ClearContents

 Application.ScreenUpdating = True
End Sub
3pointage-avec-macro-test-1.xlsm (30.43 Ko)

A chaque modification sur la feuille "pointage" , la macro s'exécute.

Cordialement,

Le 30/06/2019 à 08:45

Re,

Si tu préfères lancer la macro par un bouton....

7pointage-avec-macro-test-2.xlsm (36.42 Ko)

Cordialement,

Le 30/06/2019 à 13:09

bonjour

merci pour ces idée la 3em me plait bien,mais pour incorporer dans mon dossier de base j aurais besoin d’explication de chaque ligne pour pouvoir la modifier si ces possible.

ce code marche si les mois se suive en colonne ?

Le 30/06/2019 à 14:52

Re,

merci pour ces idée la 3em me plait bien

Celle avec le bouton ?

j aurais besoin d’explication de chaque ligne

Je ne suis pas très doué pour les explications, mais je vais essayer.

ce code marche si les mois se suive en colonne ?

Non, il faut adapter.

Un nouvel essai.....il y a certainement moyen de faire plus simple,

10pointage-avec-macro-test-mois.xlsm (43.17 Ko)

Cordialement,

Le 30/06/2019 à 15:28

merci beaucoup a toi tu ma beaucoup aider

je connais pas beaucoup les codes et je bloquais sur sa.

je vais tenter de faire un code sur bouton pour effacer des cellule quand je change année ^^ on va voir si j arrive a avoir du talent ^^

Le 30/06/2019 à 17:25

Re,

Ravi d'avoir pu t'aider,

je vais tenter de faire un code sur bouton pour effacer des cellule quand je change année ^^ on va voir si j arrive a avoir du talent ^^

Bon courage,

Spoiler

Au plus simple:

Sub Bouton1_Cliquer()
 With Sheets("resultat voulu")
   If MsgBox("Etes-vous certain de supprimer les données de la feuille resultat voulu ?", vbYesNo, "Demande de confirmation") = vbYes Then
    .Range("B6:C36,E6:F36,H6:I36,K6:L36,N6:O36,Q6:R36,T6:U36,W6:X36,Z6:AA36,AC6:AD36,AF6:AG36,AI6:AJ36").ClearContents
     MsgBox "Les données ont été effacées"
   End If
 End With
End Sub

Cordialement,

Le 30/06/2019 à 21:01

après je t'est pas dis je vais copier sur le code que tu me mis ^^ donc a demis essayer mdr

Le 03/07/2019 à 15:15

re bonjour j'ai modifier un truc mais je colle sur cette parti

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim ws1 As Worksheet
  Set ws1 = Sheets("pointage semaine")
   If Not Application.Intersect(Target, ws1.Range("O13")) Is Nothing Then ws1.Range("K17:P23").ClearContents

End Sub
tu ma donner se code et je voudrais que se code efface en plus les cellules "S17:S23" j arrive pas a savoir comment le mettre car je vaus pas efface les cellules "Q17:R23"

ps regarde la modification que j'ai fait je t'est encore copier j'espere tu m en veux pas

Private Sub CommandButton1_Click()
  Dim ws1 As Worksheet, ws2 As Worksheet   'déclaration des variables feuilles
 Dim i As Long, j As Long, dl As Long     'déclaration des variables lignes
 Dim x As Long                            'déclaration de la variable colonne

Application.ScreenUpdating = False        'évite le rafraichissement de l'écran à chaque tour de boucle

Set ws1 = Sheets("pointage semaine")              'définit la feuille ws1
Set ws2 = Sheets("pointage")        'définit la feuille ws2

dl = ws2.Range("A" & Rows.Count).End(xlUp).Row   'définit la dernière ligne utilisée de la feuille ws2 en colonne A

 For i = 9 To dl                          'boucle de la ligne 9 à la dernière ligne utilisée (feuille ws2)
  For j = 17 To 23                        'boucle de la ligne 17 à la ligne 23 (feuille ws1)
   For x = 1 To 39                        'boucle de la colonne 1 à la colonne 39 (feuille ws2 de A à AM)
       If ws2.Cells(i, x) Like ws1.Range("G" & j) Then  'si la date de la feuille ws2 correspond à la date de la feuille ws1
          ws2.Cells(i, x + 1) = ws1.Range("K" & j)      'le type de ws2 = type de ws1 (+1 car on se décale vers la droite)
          ws2.Cells(i, x + 2) = ws1.Range("Q" & j)       'le NB.H de ws2 = NB.H de ws1 (+2 car on se décale vers la droite)
       End If                             'fin de la condition
   Next x                                 'fin de la boucle sur les colonnes de ws2
  Next j                                  'fin de la boucle sur les lignes de ws1
 Next i                                   'fin de la boucle des lignes de ws2

 Application.ScreenUpdating = True        'on réactive le rafraichissement de l'écran
End Sub

Private Sub CommandButton2_Click()
  Dim ws1 As Worksheet, ws3 As Worksheet   'déclaration des variables feuilles
 Dim l As Long, j As Long, dk As Long     'déclaration des variables lignes
 Dim y As Long                            'déclaration de la variable colonne

Application.ScreenUpdating = False        'évite le rafraichissement de l'écran à chaque tour de boucle

Set ws1 = Sheets("pointage semaine")              'définit la feuille ws1
Set ws3 = Sheets("annualisation")                  'définit la feuille ws2

dk = ws3.Range("A" & Rows.Count).End(xlUp).Row   'définit la dernière ligne utilisée de la feuille ws3 en colonne A

For l = 9 To dk                          'boucle de la ligne 9 à la dernière ligne utilisée (feuille ws3)
  For j = 17 To 23                        'boucle de la ligne 17 à la ligne 23 (feuille ws1)
   For y = 1 To 39                        'boucle de la colonne 1 à la colonne 39 (feuille ws3 de A à AM)
          If ws3.Cells(l, y) Like ws1.Range("G" & j) Then  'si la date de la feuille ws3 correspond à la date de la feuille ws1
          ws3.Cells(l, y + 2) = ws1.Range("S" & j)       'le ANNU de ws3 = ANNU de ws1 (+2 car on se décale vers la droite)
       End If                             'fin de la condition
          Next y                                 'fin de la boucle sur les colonnes de ws3
  Next j                                  'fin de la boucle sur les lignes de ws1
 Next l                                   'fin de la boucle des lignes de ws3

 Application.ScreenUpdating = True        'on réactive le rafraichissement de l'écran
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim ws1 As Worksheet
  Set ws1 = Sheets("pointage semaine")
   If Not Application.Intersect(Target, ws1.Range("O13")) Is Nothing Then ws1.Range("K17:P23").ClearContents

End Sub

j'ai hesiter a laisser sur la meme bouton on verra si je change ou pas sans me planter mdr

Le 03/07/2019 à 15:41

Bonjour westcoast320, le forum,

je voudrais que se code efface en plus les cellules "S17:S23" j arrive pas a savoir comment le mettre car je vaus pas efface les cellules "Q17:R23"

If Not Application.Intersect(Target, ws1.Range("M13")) Is Nothing Then ws1.Range("K17:P23,S17:S23").ClearContents 'à chaque changement du n° de semaine, on vide le tableau

Cordialement,

PS: pour plus de clarté, n'hésite pas à mettre les codes sous balises pour une meilleure compréhension,

(5ème bouton : </> )

Le 03/07/2019 à 15:42
For i = 9 To dl                          'boucle de la ligne 9 à la dernière ligne utilisée (feuille ws2)
  For j = 17 To 23                        'boucle de la ligne 17 à la ligne 23 (feuille ws1)
   For x = 1 To 39                        'boucle de la colonne 1 à la colonne 39 (feuille ws2 de A à AM)
       If ws2.Cells(i, x) Like ws1.Range("G" & j) Then  'si la date de la feuille ws2 correspond à la date de la feuille ws1
          ws2.Cells(i, x + 1) = ws1.Range("K" & j)      'le type de ws2 = type de ws1 (+1 car on se décale vers la droite)
          ws2.Cells(i, x + 2) = ws1.Range("Q" & j)       'le NB.H de ws2 = NB.H de ws1 (+2 car on se décale vers la droite)

question pour toi les lettre i j x comment elle font pour être défini sur leur page précise?

Le 03/07/2019 à 15:45
xorsankukai a écrit :

Bonjour westcoast320, le forum,

je voudrais que se code efface en plus les cellules "S17:S23" j arrive pas a savoir comment le mettre car je vaus pas efface les cellules "Q17:R23"

If Not Application.Intersect(Target, ws1.Range("M13")) Is Nothing Then ws1.Range("K17:P23,S17:S23").ClearContents 'à chaque changement du n° de semaine, on vide le tableau

Cordialement,

PS: pour plus de clarté, n'hésite pas à mettre les codes sous balises pour une meilleure compréhension,

(5ème bouton : </> )

juste sa la loose j'ai essayer plein de truc mais pa sa

Le 03/07/2019 à 15:54

autant pour moi j'ai mal ecris desoler

Le 03/07/2019 à 16:27

Re,

Il faut que tu apprennes à maitriser les boucles, regarde ici:

https://www.excel-pratique.com/fr/vba/boucles.php

J'ai utilisé 3 boucles For...

For i = 6 To dl                          'boucle de la ligne 6 à la dernière ligne utilisée (feuille ws2)
  For j = 17 To 23                        'boucle de la ligne 17 à la ligne 23 (feuille ws1)
   For x = 1 To 36                        'boucle de la colonne 1 à la colonne 36 (feuille ws2 de A à AM)
       If ws2.Cells(i, x) Like ws1.Range("G" & j) Then  'si la date de la feuille ws2 correspond à la date de la feuille ws1
          ws2.Cells(i, x + 1) = ws1.Range("K" & j)      'le type de ws2 = type de ws1 (+1 car on se décale vers la droite)
          ws2.Cells(i, x + 2) = ws1.Range("Q" & j)       'le NB.H de ws2 = NB.H de ws1 (+2 car on se décale vers la droite)

Au premier tour de boucle i , i=6 ; j=17 ; x=1

If ws2.Cells(i, x) Like ws1.Range("G" & j) then

--->
  If ws2.Cells(6, 1) Like ws1.Range("G17") then  'ws2.cells(6,1)=A1

ws2.Cells(i, x + 1) = ws1.Range("K" & j)

--->
ws2.Cells(6, 2) = ws1.Range("K17" ) 'ws2.cells(6,2)=B1

ws2.Cells(i, x + 2) = ws1.Range("Q" & j)

--->
ws2.Cells(6, 3) = ws1.Range("Q17" ) 'ws2.cells(6,3) = C1

Cordialement,

Le 27/01/2020 à 14:36

Bonjour,

Je souhaiterait savoir si vous aurait la possibilité de m'aider a modifier une macro, un tableau excel que j'ai modifier pour un concours de pétanque ?

Cordialement,

Pimpom69

Rechercher des sujets similaires à "modification macro"