Intégrer une formule dans une macro

Résolu
Guy72 -  
Bonjour,
J'ai une macro (d'amateur) qui me permet de trier et de ranger des colonnes, et dans cette macro, je souhaiterais insérer une formule .
1) Fichier de départ avec les données
http://www.archive-host.com (ouvrir avec EXCEL)
2) Code de la macros 
Sub Liaison_2()
'Préparation Macro Xnet_Météo
'Date
    Range("A1:A2").Select
        Selection.Copy
    
    Range("BL1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("BL2").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "@"
    
'Suppressions des colonnes
    Range("A:C,E:I,J:J,R:V,Y:BJ").Select
    Selection.Delete Shift:=xlToLeft
'Heures
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "0:00"
    Range("K3").Select
    ActiveCell.FormulaR1C1 = "0:01"

Range("K2:K3").Select
    Selection.AutoFill Destination:=Range("K2:K1441"), Type:=xlFillDefault
    Range("K2:K1441").Select
    ActiveWindow.LargeScroll Down:=-36
    'Range("A2").Select
    
'Formule m/s en Km/h
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "=RC[-9]*4"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=RC[-9]*4"
    Range("M2:N2").Select
    Selection.AutoFill Destination:=Range("M2:N1441"), Type:=xlFillDefault
    Range("M2:N1441").Select
    Selection.Copy
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("M:N").Select
    Range("L3").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C+1"
    Selection.Copy
    Range("L2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("L3").Select
    Selection.ClearContents
    'Range("A2").Select
    'Application.CutCopyMode = False
    'Selection.Delete Shift:=xlToLeft

'Copie dans Fichier Météo
    'Range("A2").Select
    Range("A2:L1441").Select
    Selection.Copy
    Windows("Janvier_2018.xlsm").Activate
    Range("A9").Select
    ActiveSheet.Paste
    'Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    '.WrapText = False
        .Orientation = 0
    '.AddIndent = False
        .IndentLevel = 0
    '.ShrinkToFit = False
        .ReadingOrder = xlContext
    '.MergeCells = False
    End With
    
 Range("Z27").Select
    'Application.CutCopyMode = False
    Selection.Copy
    Range("Y5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone ', SkipBlanks _
        :=False, Transpose:=False
    'Application.CutCopyMode = False
    Range("A9").Select


3) Résultat de la macro finale
http://www.archive-host.com

3) Intégrer cette formule dans la cellule B2, puis recopier la formule jusqu'à la cellule B1441.
Avant d'aller dans le fichier "Janvier_2018" (ligne 56).

J'espère que j'ai bien détaillé et rien oublié ?
Merci de votre aide
Cordialement

14 réponses

  1.  Patrice33740
    Bonjour,

    1) Tu ne précise pas quelle formule veux-tu écrire ?
    2) Dans ton csv source la colonne qui se trouve au final en B ne contient que des erreurs #NA !!!
    3) Dans ta macro, à la fin, tu copies Z27 en Y5 mais ça n'a rien à voir avec les données copiées.

    J'ai "normalisé" ta macro, il ne reste plus qu'à voir ce que te veux en B : 

    Sub Liaison_2()
'Préparation Macro Xnet_Météo
Dim rM As Range
Dim dL As Long
  dL = Range("A" & Rows.Count).End(xlUp).Row
  With ActiveSheet
    'Corriger les valeur décimales (remplacer point par virgule)
    .Range("A2:AB" & dL).Value = .Range("A2:AB" & dL).FormulaLocal
    'Date
    .Range("BL1:BL2").Value = .Range("A1:A2").Value
    .Range("BL2").NumberFormat = "@"
    'Suppressions des colonnes
    .Range("A:C,E:I,J:J,R:V,Y:BJ").Delete Shift:=xlToLeft
    'Heures
    .Range("K2").Formula = "0:00"
    .Range("K3").Formula = "0:01"
    .Range("K2:K3").AutoFill Destination:=.Range("K2:K" & dL), Type:=xlFillDefault
    'Formule m/s en Km/h
    .Range("M2:M" & dL).FormulaR1C1 = "=RC[-9]*4"
    .Range("N2:N" & dL).FormulaR1C1 = "=RC[-9]*4"
    .Range("D2:E" & dL).Value = .Range("M2:N" & dL).Value
    'Date + 1
    .Range("L2").Value = .Range("L2").Formula + 1
    'Copie dans Fichier Météo
    Set rM = Workbooks("Janvier_2018.xlsm").Worksheets(1).Range("A9")
    .Range("A2:L" & dL).Copy rM
  End With
  'Alignements données copiées
  With rM.Resize(dL - 1, 12)
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
  End With
  'Feuille cible
  With rM.Parent
    .Range("Y5").Value = .Range("Z27").Value '?????? c'est hors de la plage des données copiées
    .Activate
    .Range("A9").Select
  End With
End Sub


    1
    1. Guy72 Auteur
      Oupsss !!!, j'ai oublié ma formule .
      B ne contient que des erreurs #NA !!!
      C'est pour ça la formule
      La voici en B2 et la copiée juqu'à E1441:
      '=SI(I9>10;I9;SI(D9<4.8;I9+0.2*(0.1345*I9-1.59)*D9;13.2+0.6215*I9+(0.3965*I9-11.37)*D9^0.16))

      Dans ta macro, à la fin, tu copies Z27 en Y5 mais ça n'a rien à voir avec les données copiées.
      Cette partie se trouve dans le fichier "Janvier_2018"
      0
      1. Patrice33740
        Re,

        Avec la mise en place de la formule formule : 
        Sub Liaison_2()
'Préparation Macro Xnet_Météo
Dim rM As Range
Dim dL As Long
Dim sF As String
  dL = Range("A" & Rows.Count).End(xlUp).Row
  With ActiveSheet
    'Corriger les valeur décimales (remplacer point par virgule)
    .Range("A2:AB" & dL).Value = .Range("A2:AB" & dL).FormulaLocal
    'Date
    .Range("BL1:BL2").Value = .Range("A1:A2").Value
    .Range("BL2").NumberFormat = "@"
    'Suppressions des colonnes
    .Range("A:C,E:I,J:J,R:V,Y:BJ").Delete Shift:=xlToLeft
    'Heures
    .Range("K2").Formula = "0:00"
    .Range("K3").Formula = "0:01"
    .Range("K2:K3").AutoFill Destination:=.Range("K2:K" & dL), Type:=xlFillDefault
    'Formule m/s en Km/h
    .Range("M2:M" & dL).FormulaR1C1 = "=RC[-9]*4"
    .Range("N2:N" & dL).FormulaR1C1 = "=RC[-9]*4"
    .Range("D2:E" & dL).Value = .Range("M2:N" & dL).Value
    'Date + 1
    .Range("L2").Value = .Range("L2").Formula + 1
    'Copie dans Fichier Météo
    Set rM = Workbooks("Janvier_2018.xlsm").Worksheets(1).Range("A9")
    .Range("A2:L" & dL).Copy rM
  End With
  With rM.Resize(dL - 1, 12)
    'Formule
    sF = "=IF(RC[7]>10,RC[7],IF(RC[2]<4.8,RC[7]+0.2*(0.1345*RC[7]-1.59)*RC[2],13.2+0.6215*RC[7]+(0.3965*RC[7]-11.37)*RC[2]^0.16))"
    .Columns("B").FormulaR1C1 = sF
    'Et remplacer par les valeurs
    .Columns("B").Value = .Columns("B").Value
    'Alignements données copiées
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
  End With
  'Feuille cible
  With rM.Parent
    .Range("Y5").Value = .Range("Z27").Value '?????? c'est hors de la plage des données copiées
    .Activate
    .Range("A9").Select
  End With
End Sub

        0
        1. Guy72 Auteur
          J'avoue que là, je ne comprends pas :

          La macro s'arrête en cours de route, je clic sur "Débogage".

          Je n'ai pas les données en colonne B2 du fichier " Récupérations des données.csv"
          0
          1. Patrice33740
            Chez moi elle fonctionne parfaitement, à condition que le deux fichiers soient ouverts et que le fichier actif soit de csv. Tu peux la mettre dans ton fichier Janvier_2018 ou dans un autre xlsm ouvert.
            0
          2. Patrice33740
            Voici une macro à mettre dans Janvier_2018, qui permet de choisir le fichier csv à ouvrir (donc ne pas l'ouvrir avant) : 
            Sub Liaison_2()
'Préparation Macro Xnet_Météo
Dim sh As Worksheet
Dim rM As Range
Dim dL As Long
Dim sF As String
  
  'Choisir le csv
  Set sh = OuvrirCsvFr
  If sh Is Nothing Then Exit Sub
  'Préparer les données à copier
  dL = sh.Range("A" & Rows.Count).End(xlUp).Row
  With sh
    'Corriger les valeur décimales (remplacer point par virgule)
    .Range("A2:AB" & dL).Value = .Range("A2:AB" & dL).FormulaLocal
    'Date
    .Range("BL1:BL2").Value = .Range("A1:A2").Value
    .Range("BL2").NumberFormat = "@"
    'Suppressions des colonnes
    .Range("A:C,E:I,J:J,R:V,Y:BJ").Delete Shift:=xlToLeft
    'Heures
    .Range("K2").Formula = "0:00"
    .Range("K3").Formula = "0:01"
    .Range("K2:K3").AutoFill Destination:=.Range("K2:K" & dL), Type:=xlFillDefault
    'Formule m/s en Km/h
    .Range("M2:M" & dL).FormulaR1C1 = "=RC[-9]*4"
    .Range("N2:N" & dL).FormulaR1C1 = "=RC[-9]*4"
    .Range("D2:E" & dL).Value = .Range("M2:N" & dL).Value
    'Date + 1
    .Range("L2").Value = .Range("L2").Formula + 1
    'Copier dans fichier Météo
    Set rM = Workbooks("Janvier_2018.xlsm").Worksheets(1).Range("A9")
    .Range("A2:L" & dL).Copy rM
  End With
  'Fermer le csv sans le modifier
  sh.Parent.Saved = True
  sh.Parent.Close
  'Finaliser le fichier Météo
  With rM.Resize(dL - 1, 12)
    'Formule
    sF = "=IF(RC[7]>10,RC[7],IF(RC[2]<4.8,RC[7]+0.2*(0.1345*RC[7]-1.59)*RC[2],13.2+0.6215*RC[7]+(0.3965*RC[7]-11.37)*RC[2]^0.16))"
    .Columns("B").FormulaR1C1 = sF
    'Et remplacer par les valeurs
    .Columns("B").Value = .Columns("B").Value
    'Alignements données copiées
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
  End With
  'Feuille cible
  With rM.Parent
    .Range("Y5").Value = .Range("Z27").Value '?????? c'est hors de la plage des données copiées
    .Activate
    .Range("A9").Select
  End With
End Sub

Private Function OuvrirCsvFr() As Worksheet
' Ouvrir un fichier .csv français, avec délimiteur de texte = " et
' séparateurs : de champs = point-virgule, décimal = virgule, de milliers = espace
'
Dim nomDossier As String          'Nom du dossier
Dim nomFichier As String          'Nom du fichier
Dim dlgFichier As FileDialog      'Boite de dialogue
Dim wbk As Workbook               'Fichier à ouvrir
  
  ' Selectionner le fichier
  nomDossier = ThisWorkbook.Path & "\"    'à adapter
  Set dlgFichier = Application.FileDialog(msoFileDialogFilePicker)
  With dlgFichier
    .InitialFileName = nomDossier
    .Title = "Sélectionner un fichier français avec extension .csv :"
    .AllowMultiSelect = False
    .InitialView = msoFileDialogViewDetails
    .ButtonName = "Sélection fichier"
    If .Filters.Count > 0 Then .Filters.Delete
    .Filters.Add "Fichiers fr .csv", "*.csv", 1
    If .Show = -1 Then nomFichier = .SelectedItems(1) Else Exit Function
  End With
  Set dlgFichier = Nothing
  ' Ouvrir le fichier
  Application.ScreenUpdating = False
  Set wbk = Workbooks.Open(Filename:=nomFichier, Format:=4, local:=True)
  wbk.Worksheets(1).Columns.AutoFit
  wbk.Worksheets(1).Rows.AutoFit
  Application.ScreenUpdating = True
  Set OuvrirCsvFr = wbk.Worksheets(1)

End Function
            0
        3. Guy72 Auteur
          Ce que je souhaite exactement, c'est avoir le résultat de la formule en colonne B (à partir de B2 à B1441) dans le fichier "Récupération des données.csv" pour remplacer les N/A.

          Après, je copie tout simplement A2:L1441 dans A9 du fichier "Janvier_2018.xlsm" (onglet "Relevés")

          Et ensuite, j"enregistre le fichier "Récupération des données.csv" sous "La date de la veille (14_Janvier_2018.csv)

          PS De toute façon, mon fichier"Janvier_2018.xlsm" est toujours ouvert avant
          0
          1. Patrice33740
            Est-ce que la dernière macro (avec choix du fichier) fonctionne ?
            Si oui, je la corrigerais pour mettre la formule dans le premier fichier au lieu du second et pour l'enregistrer.
            0
        4. Guy72 Auteur
          Bonjour,
          La macro s'arrête pour chercher un fichier......
          Il ne faut pas que je cherche un fichier, le fichier du mois en cours sera déjà ouvert.

          Voici les fichiers concernés (pour qu'il soit moins gros, j'ai supprimer 13 pages)
          1) Le fichier "Janvier_2018.xlsm"
          http://www.archive-host.com
          2) Le fichier "Récupération des données"
          http://www.archive-host.com

          Il faudrait que la macro fasse les fonctions suivantes :
          1) Celles de ma macro d'origine jusqu'à la... Ligne 56
          .............
          2) Après, il faudrait incorporer la formule pour avoir la résultat... En B2:B1441du fichier "Récupération des données.csv"

          3) Puis après Copier A2: L1441 ....En A9 dans l'onglet "Relevés" du fichier "Janvier_2018.xlsm" ...En A9
          Après j'enregistre le fichier "Récupération des données.csv" à la date de la veille soit "15_Janvier.csv"

          Cordialement

          P.S. voir mon site météo: http://www.meteo-clopiniere-sicaudiere.fr
          0
          1. Guy72 Auteur
            Bonjour,
            J'ai essayé avec ta 1ère macro en changeant l'emplacement de la formule, ça fonctionne (mais ça rame un peu), par contre à la fin ça se bloc dans le module qui se trouve dans la feuille relevés. 

            Private Sub Worksheet_Change(ByVal Target As Range)


            Sub Liaison_3()
            'Préparation Macro Xnet_Météo
            Dim rM As Range
            Dim dL As Long
            Dim sF As String
              dL = Range("A" & Rows.Count).End(xlUp).Row
              With ActiveSheet
                'Corriger les valeur décimales (remplacer point par virgule)
                .Range("A2:AB" & dL).Value = .Range("A2:AB" & dL).FormulaLocal
                'Date
                .Range("BL1:BL2").Value = .Range("A1:A2").Value
                .Range("BL2").NumberFormat = "@"
                'Suppressions des colonnes
                .Range("A:C,E:I,J:J,R:V,Y:BJ").Delete Shift:=xlToLeft
                'Heures
                .Range("K2").Formula = "0:00"
                .Range("K3").Formula = "0:01"
                .Range("K2:K3").AutoFill Destination:=.Range("K2:K" & dL), Type:=xlFillDefault
                'Formule m/s en Km/h
                .Range("M2:M" & dL).FormulaR1C1 = "=RC[-9]*4"
                .Range("N2:N" & dL).FormulaR1C1 = "=RC[-9]*4"
                .Range("D2:E" & dL).Value = .Range("M2:N" & dL).Value
                'Date + 1
                .Range("L2").Value = .Range("L2").Formula + 1

            'Formule
                sF = "=IF(RC[7]>10,RC[7],IF(RC[2]<4.8,RC[7]+0.2*(0.1345*RC[7]-1.59)*RC[2],13.2+0.6215*RC[7]+(0.3965*RC[7]-11.37)*RC[2]^0.16))"
                .Columns("B").FormulaR1C1 = sF
                'Et remplacer par les valeurs
                .Columns("B").Value = .Columns("B").Value
                'Alignements données copiées
                '.HorizontalAlignment = xlCenter
                '.VerticalAlignment = xlBottom

            'Copie dans Fichier Météo
                Set rM = Workbooks("Janvier_2018.xlsm").Worksheets(1).Range("A9")
                .Range("A2:L" & dL).Copy rM
              End With
            End Sub
            0
            1. michel_m Contributeur
              Bonjour,

              Juste de passage, excusez l'incruste:

              concernant le 14 janvier, les données sont à cheval sur les 2 feuilles Csv
              http://www.archive-host.com
              13/1 puis 14/1 depuis la ligne 62

              http://www.archive-host.com
              14/1 jusqu'à la ligne 62 puis 15/1

              c'est normal ? comment faire pour n'avoir que le 14/1 ?

              Je repasse la main, bon courage

               Michel
              0
              1. Guy72 Auteur
                Bonjour Michel,
                Oui, c'est normal car le logiciel "Xnet_Meteo" qui récupère les données sur ma station fonctionne avec l'horaire du soleil, donc moi, je récupère les données de 23h la veille à 22h59 le jours même, c'est pourquoi, en colonne K du fichier "Récupération des données.csv" j'ai les horaires actuelles (une fois le fichier transformé).
                0
            2. Patrice33740
              Bonjour,

              Voici ton fichier en retour, j'ai ajouté un bouton Récupère sur la feuille Relevés et un module Recuperation_Donnees
              https://mon-partage.fr/f/KyaM20hY/

              1
              1. Guy72 Auteur
                Impéccable !!!
                C'est tout à fait ça, merci de ton aide et de ta patience.
                Cordialement

                Par contre, j'ai un petit soucis, Mon vrai fichier s'appelle "Janvier_2018.xlsm" et quand j'utilise la macro, ça va dans le fichier "Janvier_2018 2.xlsm" et je ne vois pas dans la macro ou remplacer "Janvier_2018 2.xlsm" par "Janvier_2018.xlsm", car, il faudra que je change tous les mois...
                0
                1. Patrice33740
                  Remplaces le bouton Récupérer de type Formulaire, par un bouton ActiveX et lances la macro sur l'évènement clic de cet ActiveX.
                  0
              3. Guy72 Auteur
                Bonjour,
                Ça commence mal pour aujourd'hui.
                J'ai le message "Le fichier Recuperation_des_donnees.csv n'est pas ouvert" alors que si ?
                il est obligé d'être ouvert, s'il ne l'était pas, je ne pourrais pas mettre les données dedans.
                Cordialement
                0
                1. Patrice33740
                  Bonjour,

                  Vérifie que le nom est bien "Recuperation_des_donnees.csv"

                  Notes que, pour éviter ce genre de problème, je t'avais proposé une version qui ouvre le fichier, mais ça ne te convenait pas :
                  «La macro s'arrête pour chercher un fichier......
                  Il ne faut pas que je cherche un fichier, le fichier du mois en cours sera déjà ouvert. »

                  Démarrer la macro avec le fichier fermé présente l’intérêt de pouvoir choisir n'importe quel fichier csv quelque soit son nom, car on n'est pas obligé de mettre le nom du fichier dans la macro
                  0
              4. Guy72 Auteur
                Bonjour,
                C'est bien le nom inscrit.

                «La macro s'arrête pour chercher un fichier......
                Il ne faut pas que je cherche un fichier, le fichier du mois en cours sera déjà ouvert. »

                Oui, c'est parce que cela ouvrait l'explorateur et fallait que je cherche, le disque... le dossier... et le fichier...etc, pas pratique.

                De toute façon avec cette macro je ne travaillerais pas avec un autre nom de fichier

                Modifié
                J'ai supprimé mon fichier, j'ai pris le tient, je l'ai vidé et ça fonctionne :)
                Ça devrait aller comme ça
                0
                1. Patrice33740
                  « Oui, c'est parce que cela ouvrait l'explorateur et fallait que je cherche, le disque... le dossier... et le fichier...etc, pas pratique. »
                  Il est possible d'ouvrir directement le dossier où se trouve le fichier, mais je ne le connais pas.
                  0
                2. Guy72 Auteur
                  Vue la procédure que je fais.

                  1) Les données de la station récupérées par le logiciel "Xnet_Meteo" se mettent dans le fichier "C:\ Xnet_Meteo.csv" (1 ligne de données toute les minutes, actuellement 23732 lignes).

                  2) Quand j'ouvre une copie de ce fichier (par sécurité), j'utilise une macro qui me permet de sélectionner les données de la veille.

                  3) Ensuite, je colle le résultat de ces données dans le fichier "Recuperation_de_donnees.csv", puis comme le logiciel "Xnet_Meteo" à quelques manque de données (environ 2 à 3 minutes à chaque fois que je l'ouvre pour récupérer les données).

                  4) Donc, là, j'utilise une macro qui comble les lignes manquantes jusqu'à ce que j'ai 1440 lignes.

                  5) Et à partir de ce moment-là, j'utilise ta macro, qui permet de mettre toutes les données dans mon fichier "Janvier_2018.xlsm" et aussi d'enregistrer le fichier "Recuperation_de_donnees" sous la date de la veille dans le dossier "E:\Janvier\Meteo\2018 (ça c'est top).

                  C'est sûr, si tout pouvait se faire automatiquement.....se serait super.

                  En attendant, je tiens à dire que si j'arrive à tout ça, c'est grâce à des personnes comme toi qui sont capable de faire des macros pareilles.

                  Cordialement
                  0
              5. Guy72 Auteur
                Bonjour,
                J'ai un soucis depuis, je ne sais pas ce qui se passe ?
                Maintenant quand j'ouvre EXCEL, je n'ai plus un classeur vierge, mais j'ai le classeur 16_Janvier.csv.
                Que puis-je faire ???
                Cordialement
                0
                1. Patrice33740
                  Même après avoir redémarré le PC ?
                  0
                2. Guy72 Auteur
                  Oui, il suffit que je démarre EXCEL et j'ai à la place du classeur vide, j'ai toujours ce fichier.
                  Je suppose qu'il à pris la place de celui qui s'ouvre pas défaut (mais ou) ??
                  La solution, c'est que je n'ai pas de classeur à ouvrir au démarrage.

                  Ça y est , j'ai réussi à le supprimer en faisant "enregistré sous" ce qui m'a donné le chemin.
                  0

              Discussions similaires

              exo pix
              Xtyller

              2 réponses
              Excel formule : savoir si une cellule contient partie texte
              plunderer007

              14 réponses