Comment retraiter mes codes macros pour gestion de données BD

  • Initiateur de la discussion Initiateur de la discussion zombe
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

zombe

XLDnaute Occasionnel
Bonsoir le forum

C'est toujours un plaisir pour moi de me connecter à ce forum.
J'ai des données importées d'un logiciel que je dois retraitées.
Avec l'enregistreur, j'ai pu réaliser une 1ère partie dons le code est ci-dessous:
Code:
Sub STAT()
'
' STAT Macro
'

'
   With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Documents and Settings\pk9086\Bureau\STATSSEMAINE.txt", Destination:= _
        Range("$A$1"))
        .Name = "STATSSEMAINE"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(16, 7, 23, 3, 12, 27, 6, 4, 19, 3, 11)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Columns("A:D").Select
    Selection.Delete Shift:=xlToLeft
    Rows("2:13").Select
    Selection.Delete Shift:=xlUp
    Range("A3").Select
End Sub
J'ai obtenu un autre code qui me permet de poursuivre le traitement de mes données dont le code est ci-dessous:
Code:
    Sub test()
    Application.ScreenUpdating = False
    Dim Derlg As Long
    Dim i As Long
    Dim c As Range
    Dim x As Range

    Derlg = Range("A65536").End(xlUp).Row
    For i = Derlg To 1 Step -1
    If Len(Range("A" & i)) <> 11 Or Left(Range("A" & i), 1) = "-" Then Rows(i).Delete
    Next i

    For Each c In Range("H1:H" & Range("H65536").End(xlUp).Row)
    If c = "AU" Then c = c.Offset(0, -2)
    Next c

    Columns(6).Delete Shift:=xlToLeft

    For Each x In Range("E1:E" & Range("E65536").End(xlUp).Row)
       If (x.Value Like "*,*") Then x.Value = Replace(x.Value, ",", "")
       x.NumberFormat = "#,##0.00"
    Next x

    End Sub
1) Je souhaite qu'on revoie le code réalisé à partir de l'enregistreur pour le rendre plus lisible (voire compréhensible),
2) je souhaite qu'on fusionne les 2 macros ci possible,
3) ce code :
Code:
If Len(Range("A" & i)) <> 11 Or Left(Range("A" & i), 1) = "-" Then Rows(i).Delete
prend en compte les mots de 11 lettres ce qui n'est pas bon. je souhaite qu'on le revoie afin que ca concerne les 11 chiffres(numérique).
Cordialement
 
Re : Comment retraiter mes codes macros pour gestion de données BD

Salut
Je te comprend parfaitement.
Je vais essayé de reprendre les explications depuis le debut.
J'ai exporté des données à partir d'un logiciel que j'ai enregistré avec l'extension txt.
Le nom du fichier est STATSEMAINE.
Je veux à partir d'excel retraité les données. Pour cela, je suis obligé de passé par Donnée--dans le ruban DONNE EXTERNE, je choisis A PARTIR DE TEXTE--je choisis le fichier à retraiter...
C'est ce qsue la macro ci-dessous a permis de faire:
Code:
Sub STAT()
 '
 ' STAT Macro
 '
 
'
    With ActiveSheet.QueryTables.Add(Connection:= _
         "TEXT;C:\Documents and Settings\pk9086\Bureau\STATSSEMAINE.txt", Destination:= _
         Range("$A$1"))
         .Name = "STATSSEMAINE"
         .FieldNames = True
         .RowNumbers = False
         .FillAdjacentFormulas = False
         .PreserveFormatting = True
         .RefreshOnFileOpen = False
         .RefreshStyle = xlInsertDeleteCells
         .SavePassword = False
         .SaveData = True
         .AdjustColumnWidth = True
         .RefreshPeriod = 0
         .TextFilePromptOnRefresh = False
         .TextFilePlatform = 850
         .TextFileStartRow = 1
         .TextFileParseType = xlFixedWidth
         .TextFileTextQualifier = xlTextQualifierDoubleQuote
         .TextFileConsecutiveDelimiter = False
         .TextFileTabDelimiter = True
         .TextFileSemicolonDelimiter = False
         .TextFileCommaDelimiter = False
         .TextFileSpaceDelimiter = False
         .TextFileColumnDataTypes = Array(1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1)
         .TextFileFixedColumnWidths = Array(16, 7, 23, 3, 12, 27, 6, 4, 19, 3, 11)
         .TextFileTrailingMinusNumbers = True
         .Refresh BackgroundQuery:=False
     End With
     Columns("A:D").Select
     Selection.Delete Shift:=xlToLeft
     Rows("2:13").Select
     Selection.Delete Shift:=xlUp
     Range("A3").Select
 End Sub
J'ai demandé la fusion car les 2 macros sont complementaires.
Pour la question 3, tu peux laisser tomber.
Merci de revoir la question 1 et 2 pour moi.
Cdlt
 
Re : Comment retraiter mes codes macros pour gestion de données BD

Bonjour Zombe, Edy51 😉

Rendre plus lisible ton 1er code !?

Sinon voici les 2 fusionnés
VB:
Sub ImportSTAT()
  Dim sPath As String, sFic As String
  Dim Derlg As Long, i As Long, c As Range, x As Range
  ' Empècher le rafraichissement de l'écran ICI
  Application.ScreenUpdating = False
  ' Définir les variables
  sPath = "C:\Documents and Settings\pk9086\Bureau\"
  sFic = "STATSSEMAINE.txt"
  ' Importées les données
  With ActiveSheet.QueryTables.Add(Connection:=sPath & sFic, Destination:=Range("$A$1"))
    .Name = "STATSSEMAINE"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 850
    .TextFileStartRow = 1
    .TextFileParseType = xlFixedWidth
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1)
    .TextFileFixedColumnWidths = Array(16, 7, 23, 3, 12, 27, 6, 4, 19, 3, 11)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
  End With
  Columns("A:D").Delete Shift:=xlToLeft
  Rows("2:13").Delete Shift:=xlUp
  Range("A3").Select
  ' 2ème code
  Derlg = Range("A65536").End(xlUp).Row
  For i = Derlg To 1 Step -1
    If Len(Range("A" & i)) <> 11 Or Left(Range("A" & i), 1) = "-" Then Rows(i).Delete
  Next i
  For Each c In Range("H1:H" & Range("H65536").End(xlUp).Row)
    If c = "AU" Then c = c.Offset(0, -2)
  Next c
  Columns(6).Delete Shift:=xlToLeft
  For Each x In Range("E1:E" & Range("E65536").End(xlUp).Row)
    If (x.Value Like "*,*") Then x.Value = Replace(x.Value, ",", "")
    x.NumberFormat = "#,##0.00"
  Next x
End Sub

A+
 
Dernière modification par un modérateur:
Re : Comment retraiter mes codes macros pour gestion de données BD

Slut BrunoM45

Merci pour votre proposition.
Je viens de l'essayer mais je rencontre un débogage signalé en jaune à ce niveau :
Code:
.Refresh BackgroundQuery:=False
Pouvez-vous revoir?
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
481
Réponses
2
Affichages
371
Réponses
3
Affichages
569
Réponses
3
Affichages
518
Retour