Calcul et insertion nouvelles colonnes code VBA

Bonjour

Tout d'abord désolée si mon titre n'est pas très explicite mais je vais tenter de vous expliquer ce que je cherche à faire aujourd'hui.

En effet, je possède un fichier qui a été exporté. Mon but est dans un premier temps de copier les données de la feuille 1 pour la mettre dans la feuille 2 . ça j'ai réussis à faire. Je vous mettrais le code dès 8h40 ce matin (il est sous mon autre pc)

La seconde chose est de créer des nouvelles colonnes au nombre de 2 qui me permettront d'effectuer un calcul tout bête du genre AA2/coeff. Et cela pour toute la colonne. La dessus je bloque un peu car ce coeff est changeant. Cela dépends de la périodicité que je souhaite du genre faire mon calcul par semaine, par quinzaine ou par mois ( donc diviser par 7, 15, 30 ou 31).

J'aimerai en fait que l'utilisateur est une sorte de boite de dialogue qui s'affiche ou il entrerait son coefficient et ou la colonne se calculerait automatiquement.

Désolée mais je débute en vba et malgré mes recherches je n'ai pas su tout trouver ( ou alors je m'y prend mal lol)

voilà, jespère que ja'i bien su poser le pb. je pourrais vous faire dès 8H40 mon fichier pour que vous puissiez peut être un peu mieux comprendre ma demande.

Merci d'avance .

MaYa

Bonjour

Me revoilà

en utilisant l’enregistreur de macro voilà ce que j'ai pu faire

Sub Min_Max()
'
' Min_Max Macro
'

'
    Cells.Select
    Selection.Copy
    Sheets("Feuil2").Select
    Cells.Select
    ActiveSheet.Paste
    Columns("J:J").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "max"
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "min"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]/12"
    Range("J2").Select
    Selection.AutoFill Destination:=Range("J2:J15"), Type:=xlFillDefault
    Range("J2:J15").Select
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]/30"
    Range("K2").Select
    Selection.AutoFill Destination:=Range("K2:K15"), Type:=xlFillDefault
    Range("K2:K15").Select
End Sub

cela me permet de copier les données de la feuille 1 vers la feuille 2, puis d'insérer 2 colonnes (min et max) et enfin de calculer max = colonne I/15 et mi = colonne I/30.

mnt j aimerais créer une boite de dialogue qui me permettra de choisir les fameux coefficient (ici par exemple 15 et 30):

Une idée?

merci d'avance.

ps : mon fichier en pj si ça peut vous servir

30min-max.xlsx (10.35 Ko)

J'avance à petit pas

j'ai réussis à intégrer un inputbox afin de permettre à l'utilisateur d'entrer les coeff qu'il souhaite

certes c'est pas du code de pro mais ça fonctionne

Sub Min_Max()
'
' Min_Max Macro
'

'
    Cells.Select
    Selection.Copy
    Sheets("Feuil2").Select
    Cells.Select
    ActiveSheet.Paste
    Columns("E:E").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "max"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "min"
    Max = InputBox("saisir le coeff1")
    Min = InputBox("saisir le coeff2")
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]/12"
    Range("E2").Select
    Selection.AutoFill Destination:=Range("E2:E15"), Type:=xlFillDefault
    Range("E2:E15").Select
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]/30"
    Range("F2").Select
    Selection.AutoFill Destination:=Range("F2:F15"), Type:=xlFillDefault
    Range("F2:F15").Select
End Sub

ben en fait, je pense que c'est ce qu'il me fallait... la prochaine fois avant de poster je réfléchirais à 2 fois ^^

A plus

edit : en fait il faut que je déclare les variables min et max pour que les coeff s'appliquent quad^nd j'effectue le calcul... ça aurait été trop beau que je réussisse si rapidement lol

du coup je m'y remet ^^

quelqu’un aurait une petite idée?

je cherche donc au final à appliquer un coefficient sur la colonne E et un autre sur la colonne F

je suis un peu perdue du coup là ...

mon code marche mais les coefficient que j'entre dans le input box ne sont pas ceux que je retrouve qu final dans mon calcul...

merci

Salut MaYa,

Essaye de me donner ton fichier en .xlsm et non xlsx, je n'arrive pas à voir tes macros !

SI tu n'as pas déjà fini, je pourrais peut être t'aider

Cordialement,

Uras

Bonjour Uras

voici le fichier avec les macros

dsl je n'avais pas vu qu'elles n’étaient pas activées

merci bcp

25min-max2.xlsm (20.03 Ko)

Bonjour,

A tester et me redire.

Ctrl+w pour démarrer la procédure.

32min-max.xlsm (18.09 Ko)

Merci bcp Jean Eric C'est exactement ce qu'il me fallait. Je vais à présent pouvoir avancer.

merci encore

merci à toi aussi Uras d'avoir pris le temps de regarder

MaYa

Re,

Pense à clore le sujet, si tu es satisfaite

J'ai juste encore une toute petite question et ensuite je pense que tout sera ok

si je veux que les 2 nouvelles colonnes créées s'insèrent à la place des colonnes E et F comment dois-je procéder?

merci d'avance

MaYa

Re,

14min-max-v1.xlsm (20.41 Ko)

Re,

En modifiant 2 détails sur la macro de Jean-Eric (ligne en commentaire) :

Option Explicit
'Option Private Module
Public Sub Traitement()
' Ctrl+w pour lancer la procédure.
Dim Wss As Worksheet, _
    Wsd As Worksheet, _
    lngRow As Long, i As Long, _
    intCol As Integer, _
    min As String, max As String, _
    bmin As Byte, bmax As Byte

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    Set Wss = Worksheets("données brutes")
    Set Wsd = Worksheets("copie")

    On Error Resume Next
    Wsd.Delete
    On Error GoTo 0

    Application.DisplayAlerts = True

    Wss.Copy after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "copie"
    Set Wsd = ActiveSheet

    lngRow = Range("A" & Rows.Count).End(xlUp).Row
    intCol = Cells(1, Columns.Count).End(xlToLeft).Column
Ligne1:
    min = InputBox("Veuillez saisir le coef. min:", "Mini")
    If min = "" Then GoTo Ligne1
    bmin = CByte(min)
    'Cells(1, intCol + 1) = "min/" & min
    Cells(1, intCol - 1) = "min/" & min 'ici
ligne2:
    max = InputBox("Veuillez saisir le coef. max:", "Maxi")
    If max = "" Then GoTo ligne2
    bmax = CByte(max)
    'Cells(1, intCol + 2) = "max/" & max
    Cells(1, intCol) = "max/" & max 'ici

    For i = 2 To lngRow
        With Cells(i, intCol + 1)
            .Value = Cells(i, 4) / bmin
            .NumberFormat = "0.00"
        End With
        With Cells(i, intCol + 2)
            .Value = Cells(i, 4) / bmax
            .NumberFormat = "0.00"
        End With
    Next

    Set Wss = Nothing: Set Wsd = Nothing

End Sub

Cldt,

Uras

merci bcp c'est super

Bonne journée à vous 2

MaYa

Bonjour

Je suis désolée, je ré-ouvre à nouveau ce topic.

J'aurais encore besoin d'un petit peu d'aide

en effet je souhaite effectuer un calcul simple du genre Ap = max - min + int + top

mais quand je l’exécute j'ai une erreur d’exécution 13

Quand j’additionne les 4 colonnes aucun pb par contre le calcul si dessus ça plante. Sachant que dans int j'ai des valeurs négatives,

si je déclare la variable en tant que long pourquoi ça ne fonctionne pas?

je suis désolée mais j'ai ce sont mes premiers pas en VBA et à vrai dire je galère beaucoup...

merci

MaYa

dim ap as long
for i = 2 to lngRow
ap =  cells (i,6)- cells(i,7)+ cells (i,17)+cells (i,20)
next

J'ai ps suivi le sujet mais si ce sont des valeurs, il manque les . value:

ap =  cells (i,6).value- cells(i,7).value+ cells (i,17).value+cells (i,20).value

Bonjour,

Dim ap As Double
    For i = 2 To lngRow
        ap = Cells(i, 6) - Cells(i, 7) + Cells(i, 17) + Cells(i, 20)
    Next

re bonjour,

merci beaucoup

cette fois je pense que c'est bon ^^ tout fonctionne, plus d'erreurs

encore merci.

MaYa

Rechercher des sujets similaires à "calcul insertion nouvelles colonnes code vba"