XL 2016 Aide modification macro VBA

Fabien62

XLDnaute Occasionnel
Bonjour le forum,

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

VB:
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 :

VB:
  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
 

cp4

XLDnaute Impliqué
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.
 

ChTi160

XLDnaute Barbatruc
Bojour
Bonjour le Fil(cp4), le Forum
peut être en utilisant une variable Colonne
VB:
'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
 

cp4

XLDnaute Impliqué
Bojour
Bonjour le Fil(cp4), le Forum
peut être en utilisant une variable Colonne
VB:
'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
Bonjour @ChTi160 ;),

Une variable colonne! J'avoue je n'y avais pas pensée.
Il me reste beaucoup à apprendre. Merci.
 

Fabien62

XLDnaute Occasionnel
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
 

Fichiers joints

Dernière édition:

Fabien62

XLDnaute Occasionnel
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 :

VB:
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
 

ChTi160

XLDnaute Barbatruc
Bonjour Fabien62
Bonjour le Fil ,le Forum
VB:
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
 

Fabien62

XLDnaute Occasionnel
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
 

ChTi160

XLDnaute Barbatruc
Re
la procédure modifiée qui semble fonctionner!
VB:
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
 

Discussions similaires


Haut Bas