Traitement d un CSV en XLSX : Comment eviter la notation scientifique ?

Le 17/04/2023 à 19:24

Bonjour

1234567e020-2023-01-22-22-39-38.csv

Sub SubTraitementCSV6()
'
' SubTraitementCSV6  vu le 16 Avril 2023 '
'
'
' Pour interrompre : Appuyez sur les 2 touches "CTRL" et "ARRET DEFIL"
'
Dim Wb As Workbook
Dim FeuilleImport As Workbook
Dim Criteres As Workbook
Set Wb = ActiveWorkbook
Dim Derniere As Long
Dim Lastline As Variant
Dim feuille_courante As String
Dim nocompte As String
Dim classeur_actif As String
Dim Quel_Fichier As String
Dim Cellule As Range
Dim ligne As Range

MsgBox " Debut de SubTraitementCSV6"
'
' Ouvrir et choisir le fichier
Quel_Fichier = Application.GetOpenFilename("Fichiers CSV,  *.csv")
' Quel_Fichier = Application.GetOpenFilename("Fichiers CSV XLS XLSX ,  *.csv;*.xls;*.xlsx")
'MsgBox "1) Quel_Fichier = " & Quel_Fichier
'
suffixe = InStr(Quel_Fichier, ".csv")
'MsgBox "2) position du Suffixe = " & suffixe
'
pos2 = InStrRev(Quel_Fichier, "\")
'MsgBox "3) adresse = " & pos2
'
fichier = Mid(Quel_Fichier, pos2 + 1, suffixe - pos2 - 1)
'MsgBox "4) fichier = " & fichier
'
nocompte = Left(fichier, 11)
MsgBox " compte = " & nocompte
Index = Mid(fichier, 12, 15)
MsgBox " index = " & Index
'
' Date du jour ( format US/ENG : aaa mm jj
'
Dim DateJourUS As String
DateJourUS = Format(Now, "yyyy_mm_dd")
'
'  Application.ScreenUpdating = False pour empecher de voir defiler les ouvertures des feuilles Excel ( ne pas oublier de le remettre sur TRUE en fin de porgramme
Application.ScreenUpdating = False
'
'
' TRES IMPORTANT : toujours mettre Local:=True pour ne pas avoir des points virgules ";"
'
Set FeuilleImport = Workbooks.Open(Filename:=Quel_Fichier, local:=True, origin:=xlWindows)
'
'
    Cells.Select
    Selection.Columns.AutoFit
 '
   Range("B1").Select
    ActiveCell.FormulaR1C1 = nocompte
    t = TypeName(ActiveCell.Value)
    MsgBox " t= " & t
    nocompte = CStr(nocompte)
 ' Sauvetage AVANT remplacement des caracteres illisibles
 '
  SaveClasseur FeuilleImport, Wb.Path & "\" & DateJourUS & "_Import_" & nocompte & "_" & Index & ".xlsx"
    Range("A1").Select
    ActiveCell.SpecialCells(xlLastCell).Select
    Lastline = ActiveCell.Row
    'MsgBox " il y a " & Lastline & " lignes"
  '
  ' Ajout d'une colonne numero de compte' dans premiere colonne
  '
  Columns("A:A").Select
  Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  Range("A1").Select
  '
  ' Suppression de la colonne E contenant "Montant(FRANCS)"
  '
  Columns("E:E").Delete Shift:=xlToLeft
  ' Remplacement des caracteres illisibles et Suppression des lignes avec montants(FRANCS)
  '

  For Each Cellule In Range("A1:A" & Lastline)
     If Cellule.Offset(0, 1) Like "*Compte*" Then Cellule.Offset(0, 1).Value = "Numéro de Compte"
     If Cellule.Offset(0, 1) Like "*Solde (EUROS)*" Then Cellule.Offset(0, 2).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
     If Cellule.Offset(0, 1) Like "*/*/*" Then
        Cellule.Offset(0, 3).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
        Cellule.Offset(0, 3).ColumnWidth = 17
        Cellule.Offset(0, 4).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
        Cellule.Offset(0, 4).ColumnWidth = 17
     End If
     If Cellule.Offset(0, 2) Like "Libellé" Then
        Cellule.Offset(0, 2).Value = "Libellé"
        Cellule.Offset(0, 0).Value = "Numero Compte"
     End If
     If Cellule.Offset(0, 2) Like "* *" Then Cellule.Offset(0, 2) = Trim(Cellule.Offset(0, 2))
     If Cellule.Offset(0, 2) Like "*  *" Then Cellule.Offset(0, 2) = Replace(Cellule.Offset(0, 2), "  ", " ")
     If Cellule.Offset(0, 2) Like "*   *" Then Cellule.Offset(0, 2) = Replace(Cellule.Offset(0, 2), "   ", " ")
     If Cellule.Offset(0, 2) Like "*    *" Then Cellule.Offset(0, 2) = Replace(Cellule.Offset(0, 2), "    ", " ")
     If Cellule.Offset(0, 2) Like "*     *" Then Cellule.Offset(0, 2) = Replace(Cellule.Offset(0, 2), "     ", " ")
     If Cellule.Offset(0, 2) Like "*NÂ*" Then Cellule.Offset(0, 2) = Replace(Cellule.Offset(0, 2), "NÂ", "N")
     If Cellule.Offset(0, 3) Like "Montant(EUROS)" Then Cellule.Offset(0, 4).Value = "Montant(EUROS)"
     If Cellule.Offset(0, 3) > 0 And Cellule.Offset(0, 3) <> "Montant(EUROS)" Then
        Cellule.Offset(0, 4).Value = Cellule.Offset(0, 3)
        Cellule.Offset(0, 3).Value = ""
     End If
     '
     ' Suppression de la ligne contenant "Solde (FRANCS)" sans sortir du boucle
     '
     If Cellule.Offset(0, 1) Like "*Solde*(FRANCS)*" Then Cellule.Offset(0, 1).EntireRow.Delete
     '
     '
     '
  Next
  '
  ' Tri sur Date
  '
   Range("B7").Select
       ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key _
        :=Range("B8:B99"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets(1).Sort
        .SetRange Range("A7:E99")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

  '
  ' Ajout des libellés en ligne 7 avec GRAS et Centrage
  '
  Range("A7").Select
    ActiveCell.FormulaR1C1 = "Compte"
  Range("D7").Select
    ActiveCell.FormulaR1C1 = "Debit"
  Range("E7").Select
    ActiveCell.FormulaR1C1 = "Credit"
  '
      Range("A7:E7").Select
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
  '
    ' Figeage des 8 premieres lignes
   '
       Rows("8:8").Select
    ActiveWindow.FreezePanes = True
   '
  '
  Range("B7").Select
     Selection.End(xlDown).Select
     'Range("B71").End(xlDown).Select
    derniereligne = Range("B7").End(xlDown).Row
    MsgBox " derniere ligne = " & derniereligne
    Range("C1").Select
    Selection.Copy
    Range("A8:A" & derniereligne).Select
    ActiveSheet.Paste
    Range("A1").Select
    '

    ' Sauvetage APRES remplacement des caracteres illisibles
  '
  SaveClasseur FeuilleImport, Wb.Path & "\" & DateJourUS & "_Import_" & nocompte & "_" & Index & ".xlsx"

  MsgBox " c'est fini ! Le Fichier CSV a été transformé en XLSX "
  '
End Sub
Sub SaveClasseur(Wb As Workbook, FichierXls As String)
Wb.Application.DisplayAlerts = False
    Wb.SaveAs Filename:= _
    FichierXls, _
    FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Wb.Application.DisplayAlerts = True
End Sub

Je suis sur les traitements des fichiers CSV telechargés depuis le site Internet de la Banque Postale

Jusque là : ca va avec les fichiers CSV du genre 5678901Y20 mais depuis que j'ai à traiter un nouveau compte supplementaire ( n° compte 1234567E20 ) qui m'a ensuite posé probleme...

le nom de ce ficher CSV = 1234567E020_2023-01-22.22.39.38.csv

Apres traitement j'ai toujours dans mon XLSX :

1,234567E+26 dans cellule C1

1,234567E+26 dans colonne A juste sous "Compte"

Comment faire pour eviter ça ? je cherche à avoir 1234567E020 dans cellule C1 et dans Colonne A "Compte"

Le 17/04/2023 à 21:06

Bonjour

On n'ouvre pas un CSV, on le lie depuis toujours afin de paramétrer correctement l'import et, depuis plus de 10 ans ceci avec PowerQuery qui permet aussi de la traiter.

Cela évite les problèmes de formats de nombre comme de date

Rechercher des sujets similaires à "traitement csv xlsx comment eviter notation scientifique"