MACRO à rectifier

Le 23/08/2016 à 13:46

Bonjour

Merci de bien vouloir m'apporter de l'aide pour la rectification et la mise à jour du MACRO de mon fichier ci-joint

Tous les détails explicatifs nécessaires sont sur le fichier.

Merci d'avance.

32pointage-v2-00.xlsm (151.64 Ko)
Le 23/08/2016 à 18:56

Bonjour,

C'est le problème quand tu te fais aider par certains qui veulent jour les cadors avec des tableaux

Adresse toi directement à Mister Galopin

Voici le bon code

Sub galopin()
  Dim a, i%, k%, kk%, ki%, iC%, iR%, D, N&, x%, TPos(1 To 12, 2), DD%, DF%, S$, WsC As Worksheet
  RAZ
  Set WsC = Worksheets("JA")
  'Confection du dictionnaire
  Set D = CreateObject("Scripting.Dictionary")
  For i = 2 To 13
    With Worksheets(i)
      kk = .Cells(65535, 3).End(xlUp).Row
      For k = 12 To kk
        S = .Cells(k, 3).Text
        If S <> "" Then
          If Not D.Exists(S) Then
            x = x + 1
            D.Add S, x
          End If
        End If
      Next
    End With
  Next
  'iR sera D.item + 7
  WsC.[C8].Resize(D.Count) = Application.Transpose(D.keys)
  'Tableau des positions de chaque mois(colonnes)
  For i = 2 To 13
    '-----------------------------------------------------------------------------------
    N = Worksheets(i).[E11]  'E11 = était [D11] AVANT L'AJOUT DES COLONNES
    '-------------------------------------------------------------------------------------
    ' Déduire 42365 et non 42366 pour obtenir la 1ère colonne
    TPos(i - 1, 1) = N - 42365
  Next
  For i = 1 To 11
    TPos(i, 2) = TPos(i + 1, 1) - 1
  Next
  TPos(12, 2) = TPos(12, 1) + 30
  'Boucle sur chaque feuille "mois"
  For i = 2 To 13
    With Worksheets(i)
      DD = TPos(i - 1, 1): DF = TPos(i - 1, 2)
      kk = .Cells(65535, 3).End(xlUp).Row
      'If kk > 7 Then
      For k = 12 To kk                     'k= ligne source
        ki = D.Item(.Cells(k, 3).Text) + 7  'ki = ligne cible (D.item+7)
        x = TPos(i - 1, 2) - TPos(i - 1, 1)  'nombre de jours du mois
        ' Modifier la colonne également ici = 5ème colonne
        a = .Range(.Cells(k, 5), .Cells(k, 5 + x))
        WsC.Range(WsC.Cells(ki, TPos(i - 1, 1)), WsC.Cells(ki, TPos(i - 1, 1) + x)) = a
      Next
      'End If
    End With
  Next
End Sub

A+

Le 25/08/2016 à 21:45
BrunoM45 a écrit :

Bonjour,

C'est le problème quand tu te fais aider par certains qui veulent jour les cadors avec des tableaux

Adresse toi directement à Mister Galopin

Bonsoir BrunoM45, le Forum

Merci pour l'intervention d'aide.

Parfois on se permet pas de redéranger ce qui nous a aidé. C'est par ce principe que je ne me suis permis de contacter Galopin par MP.

Si vous permettez, juste une petite remarque concernant le code. J'ai constaté après essai que la macro déclenche une erreur si le mois de Février fait 28 jours au lieu de 29j.

Merci de bien vouloir la rectifier.

A+

Le 26/08/2016 à 10:53
cc2 cc3
Le 27/08/2016 à 10:26

Salut DEMERS

Jolies petites images

Et moi je dirai :

Aucune aide ne serait suffisante, si l'autre ne veut pas chercher à comprendre

Le 27/08/2016 à 11:04

Bonjour,

Le fichier modifié.

Remarque : A propos du 29 Février...

Le fichier sous sa forme précédente (V2) était préférable car il créait une certaine "mobilité" dans les colonnes mensuelles (Quand le 29 Février n'existe pas)

Je suis donc revenu à la présentation précédente pour la ligne 7 du "JA" ou les jours se déduisent du précédent sans interruption du 1er janvier au 31 Décembre. Si on crée une colonne vide (ou masquée) pour les années ou il n'y a que 28 jours en Février,ça ne peut pas marcher.

A+

10pointage-v3.xlsm (155.51 Ko)
Le 27/08/2016 à 14:53

bonjour

essayer ca :

10pointage-v2-01.xlsm (148.99 Ko)

code :

Sub test()
Dim f_m As String, Ja As Worksheet, C
Dim drln_m As Integer, drln As Integer, i As Integer, j As Integer,l As Byte, l0 As Integer, s As Integer
Set Ja = Worksheets("JA")
drln = Ja.Cells(Rows.Count, 3).End(xlUp).Row + 1
Ja.Range("C8:NG" & drln).ClearContents
s = 4
For i = 0 To 11
l = Day(WorksheetFunction.EoMonth("2016-01-19", i))
'If i = 1 Then l = 29 'si vous changez le nbre de colonnes de mois févier (28 ou 29) selon l année vous pouvez effacer l'instuction if , si non ajouter l instuction if
l0 = s + 1: s = s + l
f_m = Format(i + 1, "00")
With Worksheets(f_m)
drln_m = .Range("C" & Rows.Count).End(xlUp).Row
For j = 12 To drln_m
drln = Ja.Range("C" & Rows.Count).End(xlUp).Row + 1
Set C = Ja.Range("C8:C" & drln).Find(.Cells(j, 3).Value, , , xlWhole)
If Not C Is Nothing Then
Range(Ja.Cells(C.Row, l0), Ja.Cells(C.Row, s)).Value = Range(.Cells(j, 5), .Cells(j, 35)).Value
Else
Ja.Cells(drln, 3).Value = .Cells(j, 3).Value
Range(Ja.Cells(drln, l0), Ja.Cells(drln, s)).Value = Range(.Cells(j, 5), .Cells(j, 35)).Value
End If
Next
End With
Next
End Sub
Le 27/08/2016 à 18:38
galopin01 a écrit :

Bonjour,

Le fichier modifié.

Remarque : A propos du 29 Février...

Le fichier sous sa forme précédente (V2) était préférable car il créait une certaine "mobilité" dans les colonnes mensuelles (Quand le 29 Février n'existe pas)

Bonjour galopin, et tout le forum

Ravi de vous avoir croisé une autre fois sur le forum.

je pense que le problème n'est pas une question d'un jour en plus ou moins pour le mois de février.

Après plusieurs essais, et à l'exception de 2016, j'ai pu constaté qu'à chaque fois on remonte avec l'année par ex de 2016 à 2017, les données se décalent de 365 colonnes à droite du tableau. c-à-d:

2016 les données s'insèrent parfaitement au niveau du tableau

2017 Les données se décalent de 365 colonnes et s’insèrent juste après la dernière colonne du tableau

2018 Les données se décalent de 365 x 2 soit 730 colonnes au delà du tableau, . . .et ainsi de suite.

Donc il parait qu'il s'agit de qlq chose qui ne va pas dans le code.

Ci-joint le fichier un peux modifié de façon quand on change l'année de gestion au niveau de [JA], tous les tableaux des autres feuilles changent aussi, et ce, afin que vous puissiez essayer cette erreur sans avoir besoin de changer l'année sur tous les tableaux.

Cordialement

Merci BrunoM45, Merci AMIR

13pointage-v3.xlsm (169.19 Ko)
Le 27/08/2016 à 19:14

bonjour

essayer ca

9pointage-v3.xlsm (167.18 Ko)

Noter que la case de l année doit etre tjrs remlpis par une année avant de lancer la macro

Le 27/08/2016 à 19:50

bonsoir,

la macro modifiée :

Sub galopin()
Dim a, i%, k%, kk%, ki%, iC%, iR%, D, N&, x%, TPos(1 To 12, 2), Dec%, DD%, DF%, S$, WsC As Worksheet
   RAZ
   Dec = 5 '(colonne E)
   Set WsC = Worksheets("JA")
   'Confection du dictionnaire
  Set D = CreateObject("Scripting.Dictionary")
For i = 2 To 13
   With Worksheets(i)
      kk = .Cells(65535, 3).End(xlUp).Row
      For k = 12 To kk
         S = .Cells(k, 3).Text
         If S <> "" Then
            If Not D.Exists(S) Then
               x = x + 1
               D.Add S, x
            End If
         End If
      Next
   End With
Next
   'iR sera D.item + 7
   WsC.[C8].Resize(D.Count) = Application.Transpose(D.keys)
   'Tableau des positions de chaque mois(colonnes)
   For i = 2 To 13
      N = Worksheets(i).Cells(11, Dec).Value
      TPos(i - 1, 1) = N - CLng(DateSerial([Année], 1, 1)) + Dec
   Next
   For i = 1 To 11
      TPos(i, 2) = TPos(i + 1, 1) - 1
   Next
   TPos(12, 2) = TPos(12, 1) + 30
   'Boucle sur chaque feuille "mois"
   For i = 2 To 13
      With Worksheets(i)
         DD = TPos(i - 1, 1): DF = TPos(i - 1, 2)
         kk = .Cells(65535, 3).End(xlUp).Row
         For k = 12 To kk                     'k= ligne source
            ki = D.Item(.Cells(k, 3).Text) + 7  'ki = ligne cible (D.item+7)
            x = TPos(i - 1, 2) - TPos(i - 1, 1) 'nombre de jours du mois
            a = .Range(.Cells(k, 5), .Cells(k, x + 5)) '5 est la première colonne "utile"
            WsC.Range(WsC.Cells(ki, TPos(i - 1, 1)), WsC.Cells(ki, TPos(i - 1, 1) + x)) = a
         Next
      End With
   Next
End Sub

A+

Le 27/08/2016 à 20:47

ReBonsoir galopin

Oui, c'est bien parfait. Merci beaucoup. un grand merci

Merci aussi AMIR. ton code fonctionne aussi bien.

Un grand merci à vous, et je vous souhaite une très bonne soirée.

Cordialement

Rechercher des sujets similaires à "macro rectifier"