XL 2010 Correction et optimisation de code

fb62840

XLDnaute Impliqué
Bonjour,

J'utilise le code ci-dessous pour obtenir le report de données d'un fichier à l'autre.

J'ai 2 soucis :
Les reports ne semble pas se faire correctement (j'ai bien des données reportées mais ce ne sont pas les bonnes, peut être y-a-t-il un problème de ligne)
L'exécution est extrêmement lente (pourriez-vous m'aider à accélérer l'exécution ?)

2 fichiers en pièce-jointe avec explications sur feuille explications

Merci beaucoup pour votre aide.

Code:
Sub ACTU()
  Dim NumSem, NOM, CAUSE, Mois, AdresseNom As String
  Dim REM As Boolean
  Dim PlanCong, Plan As Workbook
  Dim result As Range
  Dim Jour As Byte
  NumSem = UCase(Range("B1").Value)
  Mois = Range("A1").Value & " " & Range("A2").Value
  Application.ScreenUpdating = False  
  Set PlanCong = Workbooks.Add("C:\ACT2017\DEVO\Plan_Orga_2017.xlsx")
  Set Plan = Workbooks("PLANNIF 2017")
  Workbooks("PLANNIF 2017").Activate
  Range("A23", "A146").Select 'C'est là que se trouvent les noms
  For Each Cell In Selection
  NOM = Cell.Value 
  If NOM<> "" Then 
  For i = 2 To 10 Step 2
  PlanCong.Worksheets(Mois).Activate 'on active la feuille 

  If NumMois(Month(Plan.Sheets(NumSem).Cells(2, i).Value)) & " 2017" <> Mois Then
  PlanCong.Worksheets(NumMois(Month(Plan.Sheets(NumSem).Cells(2, i).Value)) & " 2017").Activate
  Mois = ActiveSheet.Name
  End If

  Set result = PlanCong.Worksheets(Mois).Range("A1:A92").Find(What:=NOM, LookIn:=xlValues)

  If result Is Nothing Then GoTo fin
   AdresseNom = result.Address
  Jour = Day(Plan.Worksheets(NumSem).Cells(2, i).Value

  Select Case Range(AdresseNom).Offset(0, Jour).Value
  Case Is = "M"
  Cell.Offset(0, i).Value = "M"
   Case Is = "R"
  Cell.Offset(0, i).Value = "R"
  Case Is = "T"
  Cell.Offset(0, i).Value = "T"
  Case Else
  If Range(AdresseNom).Offset(0, Jour).Value <> "" Then
  Cell.Offset(0, i).Value = Range(AdresseNom).Offset(0, Jour).Value  '"ABS"
  Else
  Cell.Offset(0, i).Value = ""
  End If
  End Select

  Select Case Range(AdresseNom).Offset(-1, Jour).Value
  Case Is = "M"
  Cell.Offset(0, i - 1).Value = "M"
  Case Is = "R"
  Cell.Offset(0, i - 1).Value = "R"
  Case Is = "T"
  Cell.Offset(0, i - 1).Value = "T"
   Case Else
   If Range(AdresseNom).Offset(-1, Jour).Value <> "" Then
  Cell.Offset(0, i - 1).Value = Range(AdresseNom).Offset(-1, Jour).Value '"ABS"

  Else
  Cell.Offset(0, i - 1).Value = ""
  End If
  End Select

  Next i
  End If
  Next

  PlanCong.Close SaveChanges:=False

  Application.ScreenUpdating = True
  Set PlanCong = Nothing
End Sub
 

Pièces jointes

  • Plan_Orga_2017.xlsx
    22 KB · Affichages: 32
  • PLANNIF 2017.xlsm
    55.8 KB · Affichages: 34

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour Fb, bonjour le forum,

D'abord les erreurs...

Au niveau des déclarations des variables. Tu peux déclarer plusieurs variables dans la même ligne mais il te faut en spécifier le type de chacune d'entre elles. Sinon elle prendra le type Variant par défaut, gourmand en mémoire. La ligne :
Dim NumSem, NOM, CAUSE, Mois, AdresseNom As String

doit être :
Dim NumSem As Byte (?) , NOM As String, CAUSE As String, Mois As String, AdresseNom As String


REM est un mot clé Visual Basic (regarde l'aide VBA). Tu ne peux pas utiliser une variable avec ce mot.

NumSem = UCase(Range("B1").Value)

Quel classeur ? Quel onglet ? Si je lance ta macro telle quelle j'obtiens NumSem = ""
Idem avec la variable Mois, j'obtiens Mois = "Bonjour".

Quand tu utilise une étiquette GOTO il te faut la définir à l'endroit où tu désires renvoyer le code.
If result Is Nothing Then GoTo fin

il te faut, quelque part dans le code, une ligne au-dessus l'endroit ou tu veux renvoyer le code, un :
fin:

Si tu désires, non pas, aller à une étiquette mais sortir de la procédure, utilise plutôt :
If result Is Nothing Then Exit Sub


Il te manque une parenthèse à la fin de la ligne :
Jour = Day(Plan.Worksheets(NumSem).Cells(2, i).Value)


Pour vérifier un code il faut placer le curseur dedans et le faire tourner pas à pas avec la touche [F7]. Je ne comprends pas que tu n'arrive(s) pas à isoler les erreurs pour comprendre ce qui se passe... Puisque dès qu'il y a erreur le code s'arrête et la ligne qui pose problème est surlignée de jaune.

Pour finir, le nom du second fichier ne correspond pas dans le code au nom du fichier exemple fourni !... Et en plus il y a un mot de passe ! Pas mal...
 

Statistiques des forums

Discussions
312 947
Messages
2 093 842
Membres
105 851
dernier inscrit
aviato