Je débute en VBA

Résolu
Je ne parvient pas résoudre d'une manière correcte le problème suivant:
La valeur de la cellule doit être la valeur de la cellule a gauche - la valeur de la première colonne a gauche et cela pour autant que la cellule de gauche ne soit pas égale à 0
J'aurai une série de fichier a traiter avec des 10000 de cellules a traiter

Je débute en VBA, pouvez vous commenter les différentes actions
La 2ème marche mais le résultat n'est pas terrible => il est mauvais
En avance merci

Sub TempReel()
Dim DerniereLigne As Integer
Dim CptLigne As Integer
Dim CelSelect As Long

DerniereLigne = Range("B1").End(xlDown).Row

For CptLigne = 2 To DerniereLigne
If Range("B") <> "" Then

CelSelect = Cells(1, 3)
Cells(1, 3).Select
CelSelect.Value = CelSelect.Offset(0, -1).Value - Cells(1, 2).Value
Next

End Sub

Sub Macro2()
'
' Macro2 Macro

Range("C1").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-R1C2"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C65536"), Type:=xlFillDefault

End Sub

6 réponses

  1. Contributeur
    bonjour

    essaies cette procédure: 10 000 lignes en env. 0,17 sec. (Ram: 512 mo, proc: 3 Ghz)
    Option Explicit
    Option Base 1

    Sub calculer_si()
    Dim Derlig As Integer, Cptr As Integer
    Dim Col_B(), Col_C()
    Dim Constante As Double
    Dim Start As Single

    Start = Timer 'début chronometre

    '---------------------initialisations
    Application.ScreenUpdating = False
    Constante = Range("B1")
    Derlig = Columns("B").Find("*", , , , , xlPrevious).Row
    'mise en mémoire Ram des colonnes source (B) et Cible (C)
    Col_B = Application.Transpose(Range("B2:B" & Derlig).Value)
    ReDim Col_C(Derlig - 1)
    '---------------------calculs en ram
    For Cptr = 1 To UBound(Col_B)
    If Col_B(Cptr) <> 0 Then Col_C(Cptr) = Col_B(Cptr) - Constante
    Next
    '----------------------restitution
    Range("C2").Resize(UBound(Col_C, 1)) = Application.Transpose(Col_C)

    ' ---------------------résultat durée de la procédure
    Application.ScreenUpdating = True
    MsgBox "colonne C calculée en " & Timer - Start & " secondes."
    End Sub


    Michel
    0
    1. Bonjour chnoir1,
      Bonjour michel_m,

      La procédure avec la recopie incrémentée ne semble pas moins rapide

      Sub Macro2()
      Dim Derlig As Long
      Dim Start As Single
      Application.ScreenUpdating = False
      Start = Timer
      Derlig = Range("B" & Rows.Count).End(xlUp).Row
      Range("C2").FormulaR1C1 = "=IF(RC[-1]>0,RC[-1]-R1C2,"""")"
      Range("C2").AutoFill Destination:=Range("C2:C" & Derlig), Type:=xlFillDefault
      Range("C2:C" & Derlig) = Range("C2:C" & Derlig).Value
      Application.ScreenUpdating = True
      MsgBox "colonne C calculée en " & Timer - Start & " secondes."
      End Sub

      A+
      0
      1. Contributeur
        Bonjour,

        Tout à fait d'accord dans ce cas mais si i on écrit une formule pourquoi utiliser VBA ?

        A propos et pour notre ami Chnoir qui débute en VBA -bienvenue à bord du Titanic- une petite démo de comparaison de rapidité sur ce thème que j'avais fait il y a bien longtemps...
        https://www.cjoint.com/?3AglIs7Do9V
        0
    2. Contributeur
      Bonjour à tous,

      Je débute en VBA
      En politesse aussi, débute par là, c'est plus rapidement maitrisé...

      eric
      0
      1. Contributeur
        Bonjour Eriic

        Tiens, c'est vrai, je n'avais pas fait attention; merci d'avoir réagi
        0
        1. Merci, cela marche mais l'écriture commence en colonne c3
          En fait j'ai encore essayé quelque chose mais sa bloque, vous pouvez peux être m'aider

          Sub TempReel1()
          Dim compteur As Long
          'boucle
          For compteur = 1 To 65536
          Cells(compteur, 3).Select
          ActiveCell.Value = ActiveCell.Offset(0, -1) - Cells(1, 2)
          If ActiveCell.Offset(0 - 1) <> "" Then Exit For ' sa bloque ici
          Next compteur
          End Sub

          Merci
          0
          1. Merci a tous, solution OK

            Bonne soirée.

            Christian
            0