1. Ce site utilise des "témoins de connexion" (cookies) conformes aux textes de l'Union Européenne. Continuer à naviguer sur nos pages vaut acceptation de notre règlement en la matière. En savoir plus.

XL 2016 Aide modification macro VBA

Discussion dans 'Forum Excel' démarrée par Fabien62, 8 Janvier 2019.

  1. Fabien62

    Fabien62 XLDnaute Occasionnel

    Inscrit depuis le :
    19 Avril 2017
    Messages :
    107
    "J'aime" reçus :
    1
    Bonjour le forum,

    Voici une macro qui est utilisée dans l'un de mes fichiers et je cherche à la modifier :

    Code (Visual Basic):
    Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim deb As Date, fin As Date, t1, t2, tablo, I&, n&, Ws As Worksheet
    With Sh
      If .Name Like "Taxe*" Then 'critère
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual 'calcul manuel
        deb = DateSerial([An], .[G5], 1)
        fin = DateSerial([An], .[H5] + 1, 1)
        .Rows.Hidden = False 'RAZ
        .[A10:C72,H10:H72] = "" 'RAZ
        t1 = .[A10:C72]: t2 = [H10:H72]
        For Each Ws In Sheets(Array(Feuil1.Name, Feuil10.Name))
        tablo = Ws.[A1].CurrentRegion.Resize(, 27) 'matrice, plus rapide
        For I = 2 To UBound(tablo)
          If tablo(I, 2) >= deb And tablo(I, 2) < fin And tablo(I, 12) = "Convention" Then
            n = n + 1
            If n < 64 Then 'sécurité
              t1(n, 1) = tablo(I, 2): t1(n, 2) = tablo(I, 3)
              t1(n, 3) = tablo(I, 27): t2(n, 1) = tablo(I, 10)
            End If
          End If
        Next
        Next
        .[A10:C72] = t1: .[H10:H72] = t2
        .[A10:H72].Sort .[A10], xlAscending, Header:=xlNo 'tri
        If n < 63 Then .Rows(n + 10 & ":72").Hidden = True 'Total en ligne 73
        Application.Calculation = xlCalculationAutomatic
      End If
    End With
    End Sub
     
    Au départ, la feuille 1 et 10 utilisaient la même colonne de référence à savoir la 27, or, j'ai dû apporter des modifications à la feuille 10, ce qui fait que la référence a bougée et est devenue 40, ce qui donnerait la ligne VBA :

    Code (Visual Basic):
      tablo = Ws.[A1].CurrentRegion.Resize(, 40) 'matrice, plus rapide
    A l'heure actuelle, la macro ne fonctionne plus que sur la feuille 1, je cherche à modifier pour qu'elle fonctionne sur les deux feuilles ayant deux références différentes.

    Si nécessaire je mettrais un fichier test en ligne que je dois préparer.

    Je vous remercie pour votre aide

    Cordialement
     
  2. Chargement...

    Discussions similaires - Aide modification macro Forum Date
    Aide modification macro Forum Excel 5 Février 2018
    Demande d aide pour Modification d une macro pour tirage au sort Forum Excel 14 Janvier 2018
    Aide pour modification macros Forum Excel 12 Novembre 2017
    Aide : petite modification macro (débutant) Forum Excel 27 Octobre 2015
    Macro envoi de mail sous conditions (aide pour modification) Forum Excel 9 Juin 2015

  3. cp4

    cp4 XLDnaute Impliqué

    Inscrit depuis le :
    7 Novembre 2015
    Messages :
    517
    "J'aime" reçus :
    32
    Utilise:
    Excel 2010 (PC)
    Bonjour,

    Tu utilises le module ce code Workbook_SheetActivate. Or, là tu as modifié les références de la feuille 10, je pense qu'il faudrait utiliser pour chacune des feuilles 1 et 10 l'évènement Worksheet_Activate. c-à-d chaque feuille aura son propre code.

    Bonne journée.
     
    Fabien62 aime votre message.
  4. ChTi160

    ChTi160 XLDnaute Barbatruc

    Inscrit depuis le :
    20 Février 2005
    Messages :
    5257
    "J'aime" reçus :
    155
    Travail/Loisirs :
    Pas grand Chose , faudrait pas que je me fatigue
    Habite à:
    Loin
    Utilise:
    Excel 2010 (PC)
    Bojour
    Bonjour le Fil(cp4), le Forum
    peut être en utilisant une variable Colonne
    Code (Visual Basic):
    'en tete de module Dim deb As Date, fin As Date, t1, t2, tablo, I&, n&, Ws As Worksheet ,Col as byte
    For Each Ws In Sheets(Array(Feuil1.Name, Feuil10.Name))
        Col = IIf(Ws.Name = Feuil1.Name, 27, 40)
        tablo = Ws.[A1].CurrentRegion.Resize(, Col) 'matrice, plus rapide
    non testé!
    jean marie
     
    Fabien62 et cp4 aiment cela.
  5. cp4

    cp4 XLDnaute Impliqué

    Inscrit depuis le :
    7 Novembre 2015
    Messages :
    517
    "J'aime" reçus :
    32
    Utilise:
    Excel 2010 (PC)
    Bonjour @ChTi160 ;),

    Une variable colonne! J'avoue je n'y avais pas pensée.
    Il me reste beaucoup à apprendre. Merci.
     
    Fabien62 aime votre message.
  6. ChTi160

    ChTi160 XLDnaute Barbatruc

    Inscrit depuis le :
    20 Février 2005
    Messages :
    5257
    "J'aime" reçus :
    155
    Travail/Loisirs :
    Pas grand Chose , faudrait pas que je me fatigue
    Habite à:
    Loin
    Utilise:
    Excel 2010 (PC)
    Re
    t’inquiète cp4 moi aussi !
    jean marie
     
    Fabien62 aime votre message.
  7. Fabien62

    Fabien62 XLDnaute Occasionnel

    Inscrit depuis le :
    19 Avril 2017
    Messages :
    107
    "J'aime" reçus :
    1
    Bonsoir ChTi160 et Cp4, le Forum,

    Merci pour votre participation et votre solution proposée que je vais tester.

    Voici le fichier pour essai si vous voulez essayer de votre côté également

    Petite erreur de ma part, la nouvelle réf de colonne est 43 et non 40

    Merci beaucoup

    Cordialement
     

    Pièces jointes:

    Dernière édition: 9 Janvier 2019
  8. Fabien62

    Fabien62 XLDnaute Occasionnel

    Inscrit depuis le :
    19 Avril 2017
    Messages :
    107
    "J'aime" reçus :
    1
    Bonjour,

    J'ai testé la macro, je pense avoir fais une erreur car j'ai une erreur d'exécution 9

    Voici comment j'ai intégré votre solution :

    Code (Visual Basic):
    Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim deb As Date, fin As Date, t1, t2, tablo, I&, n&, Ws As Worksheet, Col As Byte
    With Sh
      If .Name Like "Taxe*" Then 'critère
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual 'calcul manuel
        deb = DateSerial([An], .[G5], 1)
        fin = DateSerial([An], .[H5] + 1, 1)
        .Rows.Hidden = False 'RAZ
        .[A10:C72,H10:H72] = "" 'RAZ
        t1 = .[A10:C72]: t2 = [H10:H72]
        For Each Ws In Sheets(Array(Feuil1.Name, Feuil10.Name))
        Col = IIf(Ws.Name = Feuil1.Name, 27, 43)
        tablo = Ws.[A1].CurrentRegion.Resize(, Col) 'matrice, plus rapide
        For I = 2 To UBound(tablo)
          If tablo(I, 2) >= deb And tablo(I, 2) < fin And tablo(I, 12) = "Convention" Then
            n = n + 1
            If n < 64 Then 'sécurité
              t1(n, 1) = tablo(I, 2): t1(n, 2) = tablo(I, 3)
              t1(n, 3) = tablo(I, 43): t2(n, 1) = tablo(I, 10)
            End If
          End If
        Next
        Next
        .[A10:C72] = t1: .[H10:H72] = t2
        .[A10:H72].Sort .[A10], xlAscending, Header:=xlNo 'tri
        If n < 63 Then .Rows(n + 10 & ":72").Hidden = True 'Total en ligne 73
        Application.Calculation = xlCalculationAutomatic
      End If
    End With
    End Sub
    Cordialement
     
  9. ChTi160

    ChTi160 XLDnaute Barbatruc

    Inscrit depuis le :
    20 Février 2005
    Messages :
    5257
    "J'aime" reçus :
    155
    Travail/Loisirs :
    Pas grand Chose , faudrait pas que je me fatigue
    Habite à:
    Loin
    Utilise:
    Excel 2010 (PC)
    Bonjour Fabien62
    Bonjour le Fil ,le Forum
    Code (Visual Basic):
    If n < 64 Then 'sécurité
              t1(n, 1) = tablo(I, 2): t1(n, 2) = tablo(I, 3)
              t1(n, 3) = tablo(I, 43): t2(n, 1) = tablo(I, 10)
    End If
    je vois que dans cette partie du code , il y apparaît "43" ça peut poser problème si traitement de feuil1.name(27)
    mais sans fichier difficile de tester.
    jean marie
     
  10. Fabien62

    Fabien62 XLDnaute Occasionnel

    Inscrit depuis le :
    19 Avril 2017
    Messages :
    107
    "J'aime" reçus :
    1
    Bonjour ChTi160,

    Un fichier test est présent dans mon message d'hier à 18h53 un peu plus haut dans le fil de messages.

    Merci beaucoup

    Cordialement
     
  11. ChTi160

    ChTi160 XLDnaute Barbatruc

    Inscrit depuis le :
    20 Février 2005
    Messages :
    5257
    "J'aime" reçus :
    155
    Travail/Loisirs :
    Pas grand Chose , faudrait pas que je me fatigue
    Habite à:
    Loin
    Utilise:
    Excel 2010 (PC)
    Re
    la procédure modifiée qui semble fonctionner!
    Code (Visual Basic):

    Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim deb As Date, fin As Date, t1, t2, tablo, I&, n&, Ws As Worksheet
     Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual 'calcul manuel
    With Sh
      If .Name Like "Taxe*" Then 'critère  
        deb = DateSerial([An], .[G5], 1)
        fin = DateSerial([An], .[H5] + 1, 1)
        .Rows.Hidden = False 'RAZ
        .[A10:C72,H10:H72] = "" 'RAZ
        t1 = .[A10:C72]: t2 = [H10:H72]
        For Each Ws In Sheets(Array(Feuil1.Name, Feuil10.Name))
         col = IIf(Ws.Name = Feuil1.Name, 27, 43)
        tablo = Ws.[A1].CurrentRegion.Resize(, col) 'matrice, plus rapide
        For I = 2 To UBound(tablo)
          If tablo(I, 2) >= deb And tablo(I, 2) < fin And tablo(I, 12) = "Convention" Then
            n = n + 1
            If n < 64 Then 'sécurité
              t1(n, 1) = tablo(I, 2): t1(n, 2) = tablo(I, 3)
              t1(n, 3) = tablo(I, col): t2(n, 1) = tablo(I, 10)
            End If
          End If
        Next
        Next
        .[A10:C72] = t1: .[H10:H72] = t2
        .[A10:H72].Sort .[A10], xlAscending, Header:=xlNo 'tri
        If n < 63 Then .Rows(n + 10 & ":72").Hidden = True 'Total en ligne 73
      End If
    End With
       Application.Calculation = xlCalculationAutomatic
    End Sub
    jean marie
     
    Fabien62 aime votre message.
  12. Fabien62

    Fabien62 XLDnaute Occasionnel

    Inscrit depuis le :
    19 Avril 2017
    Messages :
    107
    "J'aime" reçus :
    1
    Bonsoir,

    Merci beaucoup Jean-Marie c'est parfait

    Cdlt
     

Partager cette page