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

[zombe]

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:

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:

    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 :

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

 

[eddy51]

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

j'ai pas trop compris ton 3) tu souhaite qu'il te renvoie ta chaine de caracteres et qu'il la transforme en chiffre

 

[eddy51]

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

en faite j'ai pas bien compris les 3 questions mdr désolé enfin la 2 je la comprend mais je vois pas comment faire sans avoir fait la question 1

 

[zombe]

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:

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

 

[Compte Supprimé 979]

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

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+

 

[zombe]

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 :

.Refresh BackgroundQuery:=False

Pouvez-vous revoir?