Lenteur de la macro

[roidurif]

Bonjour,

J'ai des lenteurs lorsque mon tableau commence à etre volumineux, j'ai deux en onglet
- Onglet DATA
- Onglet controle

Lorsque mon tableau dans l'onglet DATA prends de l'empleur j'ai la macro qui prend du temps. le tableau peux varier en 500 à 8000 lignes.

Cette macro contôle dans la colonne AH (Prix) de l'onglet DATA si le fomat est 0.00 et non 0,00.

Si quelqu'un peut m'aider si possible

Sub Ctrl_Prix() 'Contrôle Format Prix
Dim R As Range
Dim c As Range
Dim DecSep$
Dim x#
Dim SystemSeparator$
Dim tampon$
Dim LenTampon&
With Application
  If Application.UseSystemSeparators Then
    tampon$ = Space(255)
    LenTampon& = GetLocaleInfo(GetSystemDefaultLCID, &HE, tampon$, 255)
    DecSep$ = Left$(tampon$, LenTampon& - 1)
  Else
    DecSep$ = Application.International(xlDecimalSeparator)
  End If
End With
Sheets(CONTROLE).Range("B14:IV14").Clear
With Sheets(DATA)
  Set R = .Range("AH2", .[AH65536].End(xlUp))
  For Each c In R
    If DecSep$ = "." Then
      c.Replace ",", DecSep$
    ElseIf DecSep$ = "," Then
      c.Replace ".", DecSep$
    End If
    c = c.Value     '******28/01/09******
    c.NumberFormat = "0.00"
    If IsNumeric(c) Then
      c.HorizontalAlignment = xlRight '******28/01/09******
        c = CDbl(c)
        '--- Détection des nombres avec plus de 2 décimales ---
      x# = c
      If CDbl(CLng(x# * 100) / 100) <> x# Then
        c.NumberFormat = "General"
        Sheets(CONTROLE).Range("IV14").End(xlToLeft).Offset(0, 1).Value = c.Address(REF_ABS, REF_ABS)
      End If
        '------------------------------------------------------
    Else
      Sheets(CONTROLE).Range("IV14").End(xlToLeft).Offset(0, 1).Value = c.Address(REF_ABS, REF_ABS)
    End If
  Next c
End With
Call CleanImages
End Sub

 

[BERRACHED said]

Re : Lenteur de la macro

Salut,roidurif et le Forum

essaye de mettre ton code comme ceci:

Application.ScreenUpdating = False
'met ton code ici
Application.ScreenUpdating = True

Cordialement

 

[PMO2]

Re : Lenteur de la macro

Bonjour,

Essayez de remplacer votre code par le code suivant

ATTENTION faites l'essai sur une copie de votre classeur.

Sub Ctrl_Prix() 'Contrôle Format Prix
Dim R As Range
Dim DecSep$
Dim x#
Dim SystemSeparator$
Dim tampon$
Dim LenTampon&
Dim var
Dim i&
Dim A$
With Application
  If Application.UseSystemSeparators Then
    tampon$ = Space(255)
    LenTampon& = GetLocaleInfo(GetSystemDefaultLCID, &HE, tampon$, 255)
    DecSep$ = Left$(tampon$, LenTampon& - 1)
  Else
    DecSep$ = Application.International(xlDecimalSeparator)
  End If
End With
Sheets(CONTROLE).Range("B14:IV14").Clear

Set R = Sheets(DATA).Range("AH2", Sheets(DATA).[AH65536].End(xlUp))
var = R
For i& = 1 To UBound(var, 1)
  A$ = CStr(var(i&, 1))
  If DecSep$ = "." Then
    A$ = Replace(A$, ",", DecSep$)
  ElseIf DecSep$ = "," Then
    A$ = Replace(A$, ".", DecSep$)
  End If
  If IsNumeric(A$) Then
    '--- Détection des nombres avec plus de 2 décimales ---
    If Len(Mid(A$, InStr(1, A$, DecSep$) + 1)) > 2 Then
      x# = CDbl(A$)
      x# = CDbl(CLng(x# * 100) / 100)
      A$ = CStr(x#)
    End If
  Else
    Sheets(CONTROLE).Range("IV14").End(xlToLeft).Offset(0, 1).Value = "AH" & i& + 1 & ""
  End If
  var(i&, 1) = A$
Next i&
R = var
R.NumberFormat = "0.00"
R.HorizontalAlignment = xlRight
 
Call CleanImages
End Sub

Cordialement.

PMO
Patrick Morange

 

[roidurif]

Re : Lenteur de la macro

Bjr PMO2,

J'ai oublié de dire que les prix peuvent être en milliers, la macro voit cela comme une erreure


000.00
0000.00
00000.00
etc

La macro est rapide mais ne prend pas compte les milliers, etc...

Merci de ton aide

 

[PMO2]

Re : Lenteur de la macro

Bonjour,

J'ai Ajouté une ligne et en ai modifié une autre

Sub Ctrl_Prix() 'Contrôle Format Prix
Dim R As Range
Dim DecSep$
Dim x#
Dim SystemSeparator$
Dim tampon$
Dim LenTampon&
Dim var
Dim i&
Dim A$
With Application
  If Application.UseSystemSeparators Then
    tampon$ = Space(255)
    LenTampon& = GetLocaleInfo(GetSystemDefaultLCID, &HE, tampon$, 255)
    DecSep$ = Left$(tampon$, LenTampon& - 1)
  Else
    DecSep$ = Application.International(xlDecimalSeparator)
  End If
End With
Sheets(CONTROLE).Range("B14:IV14").Clear

Set R = Sheets(DATA).Range("AH2", Sheets(DATA).[AH65536].End(xlUp))
var = R
For i& = 1 To UBound(var, 1)
  A$ = CStr(var(i&, 1))
  If DecSep$ = "." Then
    A$ = Replace(A$, ",", DecSep$)
  ElseIf DecSep$ = "," Then
    A$ = Replace(A$, ".", DecSep$)
  End If
  A$=Replace(A$," ","")   'ajout pmo
  If IsNumeric(A$) Then
    '--- Détection des nombres avec plus de 2 décimales ---
    If Len(Mid(A$, InStr(1, A$, DecSep$) + 1)) > 2 Then
      x# = CDbl(A$)
      x# = CDbl(CLng(x# * 100) / 100)
      A$ = CStr(x#)
    End If
  Else
    Sheets(CONTROLE).Range("IV14").End(xlToLeft).Offset(0, 1).Value = "AH" & i& + 1 & ""
  End If
  var(i&, 1) = A$
Next i&
R = var
R.NumberFormat = "#,##0.00"  'modification pmo
R.HorizontalAlignment = xlRight
 
Call CleanImages
End Sub

Est-ce mieux ?

PMO
Patrick Morange

 

[roidurif]

Re : Lenteur de la macro

J'ai cela comme donnée en prix et alors ke le format est correct, sur certain chiffre, il voit cela comme un erreur je ne comprend pas

merci

711.75
1175.3
115.00
854.10
46
711.75
40.00
46.00
1 175.30
60.00
69.00
4 088.00
299.00
1 660.75
115.00
1 215.45
60.00
69.00
1 492.85
80.00
92.00

 

[PMO2]

Re : Lenteur de la macro

Bonjour,

Je ne peux rien dire sans avoir votre classeur sous les yeux.

Cordialement.

PMO
Patrick Morange

 

[roidurif]

Re : Lenteur de la macro

Ci joint mon fichier qui assez lourd

Macro controles_V.0.9.zip


merci

cordialement

 

[roidurif]

Re : Lenteur de la macro

Bonjour,

En utilsant la macro que vous m'avez fait parvenir, Alors ke le format est correct, il voit cela comme une erreure sur certain chiffre,

Le post du 23/02 contenait mon fichier avec l'ancienne macro.

Pouvez vous voir svp?


Merci de votre aide