Traitement sur une plage de cellules en VBA

[Jerome87]

Bonjour à tous,

Je cherche à faire un traitement sur une plage de cellules en VBA, mais sans réussite, sois j’ai des problèmes de mémoire insuffisante, sois les chiffres donnés en finalité ne correspondent à rien…

Voici ce que je souhaite obtenir :

1/ Je défini un coeff correcteur
2/J’ouvre un fichier source (Fichier A). Je copie ses données (nombres entiers)
3/Je crée un nouveau tableur Excel (Fichier B). Je colle les données.
4/J’applique le coeff correcteur à toutes les valeurs précédemment collées.
5/Je quitte et enregistre ce ficher sous un nom spécifique.

L’étape qui cloche, c’est celle ou j’applique le coeff multiplicateur, les résultats ne sont pas les bons dans le fichier B… Problème de variable, de code en général ?

En espérant qu’une âme charitable puisse localiser mon problème…

Merci, bonne journée !

Voici le code :

'Définition variable coeff correcteur %
    Dim coefffocale1 As Currency
    coefffocale1 = Range("B3").Value

        'Ouverture table source
        
    Workbooks.Open Filename:= _
        lientable1
    Dim nomfichiersource As String
    nomfichiersource = ActiveWorkbook.Name

        'Copies données
    Range("A1:I105").Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.Close savechanges:=False
               
        'Création nouvau Tableur Excel
        
    Dim exc As New Excel.Application
    Workbooks.Add
    Sheets("Feuil1").Select
    Dim nomfichiercorrigé As String
    nomfichiercorrigé = ActiveWorkbook.Name

        'Collage données
    ActiveSheet.Paste
     

    Dim r As Range 'Range source à tester
    Dim c  As Range 'Cellule du range source
    Dim I As Currency ' Valeur temporaire de calcul
    Set r = Range("B2:B105")
    For Each c In r
    I = c.Value
    While I Mod 60 <> 0
    I = I * coefffocale1
    Wend
    c.Offset(1, 0).Value = I 'Affecte valeur à cellule en dessous ..
    Next
    
        
    'Enregistrment
    
   Dim NomFichier As String
 
NomFichier = "test_exportation_csv.csv"
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & NomFichier, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
  ActiveWorkbook.Close
        
End With
End Sub

 

[Compte Supprimé 979]

Re : Traitement sur une plage de cellules en VBA

Bonsoir botbot160787

Je ne comprends pas très bien tes 2 boucles imbriquées

 For Each c In r    I = c.Value
    While I Mod 60 <> 0
      I = I * coefffocale1
    Wend
    c.Offset(1, 0).Value = I  'Affecte valeur à cellule en dessous ..
  Next

Je ne vois pas pourquoi tu utilises un While ... Wend

Peux-tu nous mettre un fichier exemple ?

A+

 

[Jerome87]

Re : Traitement sur une plage de cellules en VBA

Bonjour et merci BrunoM45 pour la réponse,

C'est un code que j'ai trouvé sur le net, qui permet normalement de faire un certain traitement sur toute une plage de cellule en vba (en l’occurrence ici multiplier par un coeff les cellules B2:B105)

J'ai fait un fichier simplifié avec des explication en pièces jointe, ce sera beaucoup plus parlant !

Le principe du fichier :

L'opérateur relève des valeurs d'éclairement d'un dispositif.
Ce dispositif est programmé/piloté par les valeurs dans l'onglet "table source".
Si les valeurs relevées sont non conformes, (en dehors d'une plage de tolérance), il faut modifier la table (Table corrigée) et reprogrammer l'équipement avec.
D'où l'utilité du "coefficient correcteur"...

Merci de votre aide, bonne journée !

 

[Compte Supprimé 979]

Re : Traitement sur une plage de cellules en VBA

Salut botbot160787

Le code à utiliser est le suivant

Sub Rectangle8_Clic()
   ' La définition des variables se fait en début de procédure (plus lisible)
  Dim r As Range  'Range source à tester
  Dim c As Range  'Cellule du range source
  Dim I As Currency  ' Valeur temporaire de calcul
  ' Définition variable coeff correcteur %
  Dim coefffocale1 As Currency
  ' Utilisation de Round si l'on souhaite arrondir le coeff à 2 décimales
  coefffocale1 = Round(Range("B3").Value, 2)
  ' Copie de la table source
  Sheets("Table source").Copy After:=Sheets(Sheets.Count)
  'Création nouvelle table Excel
  ActiveSheet.Name = "Table corrigée"
  ' Définir la zone à modifiée
  Set r = Sheets("Table corrigée").Range("B2:B105")
  ' pour chaque cellule
  For Each c In r
    If c.Value Mod 60 <> 0 Then
      ' Si on veut on peut passer par une variable pour le calcul
      I = c.Value * coefffocale1
      'Affecte valeur à cellule en dessous .. POURQUOI !?
      c.Offset(1, 0).Value = I
    End If
  Next
End Sub

J'avoue ne pas tout comprendre dans la démarche

Reviens vers nous si le résultat escompté n'est pas celui-là

A+

 

[Jerome87]

Re : Traitement sur une plage de cellules en VBA

Edit :

J'ai compris !

La ligne de code ci dessous n'avait enfet aucune utilité :

 c.Offset(1, 0).Value = I

En la supprimant, on obtient le code suivant qui fonctionne très bien

Sub Rectangle8_Clic()
   ' La définition des variables se fait en début de procédure (plus lisible)
  Dim r As Range  'Range source à tester
  Dim c As Range  'Cellule du range source
  Dim I As Currency  ' Valeur temporaire de calcul
  ' Définition variable coeff correcteur %
  Dim coefffocale1 As Currency
  ' Utilisation de Round si l'on souhaite arrondir le coeff à 2 décimales
  coefffocale1 = Round(Range("B3").Value, 2)
  ' Copie de la table source
  Sheets("Table source").Copy After:=Sheets(Sheets.Count)
  'Création nouvelle table Excel
  ActiveSheet.Name = "Table corrigée"
  ' Définir la zone à modifiée
  Set r = Sheets("Table corrigée").Range("B2:B105")
  ' pour chaque cellule
 For Each c In r
    If c.Value Mod 60 <> 0 Then
      ' Si on veut on peut passer par une variable pour le calcul
      c.Value = c.Value * coefffocale1    
    End If
  Next
End Sub

Merci de m'avoir éclairer Bruno M45 !

 

[Compte Supprimé 979]

Re : Traitement sur une plage de cellules en VBA

Re,

En fait la ligne

If c.Value Mod 60 <> 0 Then

L'opérateur Mod est le modulo d'un nombre par un aute, permet de diviser deux nombres en ne renvoyant que le reste.

J'avoue que je ne comprenais pas non plus pourquoi ce teste

Il suffit donc de supprimer le test

Sub MaJCoef()
  ' La définition des variables se fait en début de procédure (plus lisible)
  Dim r As Range  'Range source à tester
  Dim c As Range  'Cellule du range source
  Dim I As Currency  ' Valeur temporaire de calcul
  ' Définition variable coeff correcteur %
  Dim coefffocale1 As Currency
  ' Utilisation de Round si l'on souhaite arrondir le coeff à 2 décimales
  coefffocale1 = Round(Range("B3").Value, 2)
  ' Copie de la table source
  Sheets("Table source").Copy After:=Sheets(Sheets.Count)
  'Création nouvelle table Excel
  ActiveSheet.Name = "Table corrigée"
  ' Définir la zone à modifiée
  Set r = Sheets("Table corrigée").Range("B2:B105")
  ' pour chaque cellule
  For Each c In r
      ' Si on veut on peut passer par une variable pour le calcul
      I = c.Value * coefffocale1
      'Affecte valeur à cellule en dessous .. POURQUOI !?
      c.Value = I
  Next
End Sub

A+