Macro création de fichier texte

[Sandrine123]

Bonjour,

Je sollicite votre aide pour une macro Excel.

J'ai un tableau qui va des colonnes A à Z.

Nous avons des valeurs dans la colonne X.

Dans la colonne Z2, il faudrait que la macro calcule la moyenne des 2 valeurs qui se trouve dans la colonne X. (X2 et X3) et ainsi de suite. La moyenne en Z4 reprend la moyenne des 2 valeurs X4 et X5.

Une fois les moyennes calculées, il faudrait que : lorsque la cellule est vide dans la colonne Z, cela supprime la ligne entière.

Une fois cela fait, il faudrait que la macro génère un fichier texte (dans le dossier ou se trouve le fichier excel) en fonction du nom du dossier dans la colonne B.
C'est à dire autant de fichier texte que de ligne de la colonne B. (ici nous devons avoir 11 fichiers textes)

Le fichier doit avoir cette mise en page :

AAA;
BBB;TEST;
CCC;DDD;
DOSSIER;A.2014.2;
CALCUL;Moyenne;4,11;
END

J'ai joins dans le zip un exemple du fichier texte à obtenir.

Merci d'avance de votre aide.

Bonne journée.

 

[klin89]

Re : Macro création de fichier texte

Bonsoir Sandrine,

Pour la moyenne en colonne Z :

Sub Moyenne()
Dim i As Long
    With Sheets("Feuil1")
        .Cells(1, 26).Value = "Moyenne"
        For i = 2 To .Cells(.Rows.Count, 24).End(xlUp).Row Step 2
            .Cells(i, 26) = WorksheetFunction.Average(.Cells(i, 24).Resize(2))
        Next
    End With
End Sub

klin89

 

[Sandrine123]

Re : Macro création de fichier texte

Bonjour,

Merci klin89 pour ce début de macro

______________
Le reste de la macro est-il faisable ou est-ce compliqué ?

Bonne journée à tous.

 

[job75]

Re : Macro création de fichier texte

Bonjour Sandrine123, klin89,

Voyez le fichier joint, il est inutile de supprimer les lignes quand la cellule est vide en colonne Z.

1) Classiquement il peut y avoir plus de 2 cellules à moyenner, ou bien la feuille peut être triée dans un autre ordre, donc formule en Z2 à tirer vers le bas :

=SI(LIGNE()=EQUIV(B2;B:B;0);SOMME.SI(B:B;B2;X:X)/NB.SI(B:B;B2);"")

2) La macro pour créer les fichiers textes :

Sub FichiersTextes()
Dim chemin$, c As Range
chemin = ThisWorkbook.Path & "\"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
ActiveSheet.Copy 'copie de la feuille dans un nouveau document
For Each c In [Z:Z].SpecialCells(xlCellTypeFormulas, 1)
  Workbooks.Add 'nouveau document vierge
  [A1] = "AAA;"
  [A2] = "BBB;TEST;"
  [A3] = "CCC;DDD;"
  [A4] = "DOSSIER;" & c.Offset(, -24) & ";"
  'remplacement de la virgule par le point
  [A5] = "CALCUL;Moyenne;" & Replace(c, ",", ".") & ";"
  'remplacement de la virgule par une "fausse" virgule
  '[A5] = "CALCUL;Moyenne;" & Replace(c, ",", Chr(130)) & ";"
  [A6] = "END"
  ActiveWorkbook.SaveAs chemin & "Dossier " & c.Offset(, -24) & ".txt", xlText
  ActiveWorkbook.Close True
Next
ActiveWorkbook.Close False
End Sub

Bien noter que pour afficher la moyenne il faut remplacer la virgule par un point ou par une "fausse" virgule de code 130.

Sinon eh bien testez pour voir ce que ça donne avec :

[A5] = "CALCUL;Moyenne;" & c & ";"

Noter aussi qu'on pourrait créer des fichiers CSV.

A+

 

[job75]

Re : Macro création de fichier texte

Re,

Une formule plus simple en Z2 :

=SI(NB.SI(B$1:B1;B2);"";SOMME.SI(B:B;B2;X:X)/NB.SI(B:B;B2))

De plus sur Excel 2007 et versions suivantes on peut utiliser MOYENNE.SI :

=SI(NB.SI(B$1:B1;B2);"";MOYENNE.SI(B:B;B2;X:X))

Il faut savoir que si la base de données est organisée en "Tableau" (onglet Insertion => Tableau) la formule est automatiquement copiée quand on ajoute une ligne.

Par ailleurs j'ajoute un test de sécurité au cas où il n'y aurait pas de formule-nombre en colonne Z :

Sub FichiersTextes()
If Application.Count([Z:Z]) = 0 Then Exit Sub 'sécurité
Dim chemin$, c As Range
chemin = ThisWorkbook.Path & "\"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next 'si l'un des fichiers texte est ouvert
ActiveSheet.Copy 'copie de la feuille dans un nouveau document
For Each c In [Z:Z].SpecialCells(xlCellTypeFormulas, 1)
  Workbooks.Add 'nouveau document vierge
  [A1] = "AAA;"
  [A2] = "BBB;TEST;"
  [A3] = "CCC;DDD;"
  [A4] = "DOSSIER;" & c.Offset(, -24) & ";"
  'remplacement de la virgule par le point
  [A5] = "CALCUL;Moyenne;" & Replace(c, ",", ".") & ";"
  'remplacement de la virgule par une "fausse" virgule
  '[A5] = "CALCUL;Moyenne;" & Replace(c, ",", Chr(130)) & ";"
  [A6] = "END"
  ActiveWorkbook.SaveAs chemin & "Dossier " & c.Offset(, -24) & ".txt", xlText
  ActiveWorkbook.Close True
Next
ActiveWorkbook.Close False
End Sub

Fichier (2).

A+