excel et fichier text.........la galere

Question

bonjour a tous,

 

 voici mon probleme: je dispose d'un fichier contenant le suivi journalier d'un automate d'analyse biologique. du type:

 
 
   E 
1-61        61173809  
Urine                   
23/11/05 16:25
 
      
COCA       
0           

      OPIA      
91           
 
   

I N  0- 0       
61173811  
Urine                                 

 
 
 
    N 
1-12        61173807  
Urine                   
23/11/05 15:34
 
      
AMPH      
45           

     
BARB       
0           
      BENZO    11005           

     CANNA      
65           

     
COCA       
0           
       EDDP    13117           

     
OPIA       
0           
 
 
       

 je souhaiterai l'exporter sous excel pour avoir qqchose qui ressemble a &#231;a:

 

Patient        /   Matrice 
/       Date     / 
  coca  /  opia  / amph /  barb  / benzo
.....

61173809   /     urine   
/  23/11/05   /   0  
     /   91  
/          
/          /

61173807   /     urine   
/  23/11/05   /   0  
     /  0     
/    45   /   0     
/  11005

 ect....

 

 il faudrait que lorsque il y a un "I" devant le code patient, celui ne soit pas pris en compte.

 rq: les "/" representent les cellules d'excel.

waspy59 · Answer

j'ai oublier de preciser:

 


je pense qu'il faut analyser le fichier ligne par ligne mais je me
casse la tete sur la procedure et sa mise en oeuvre, donc toute aide
est a bienvenue.

 

 merci d'avance

FMatrix07 · Answer

Envoi moi ton fichier je regarde et te fais un programme
puis je t'envoi les sources
[mailto:Dhreat01@yahoo.fr FMATRIX07]

crenaud76 · Answer

Ton pb vient sans doute du faite justment qu'il ne faut pas analysé ton fichier ligne par ligne, mais bloc par bloc !!
Il faut lire un bloc de ligne et les stocker dans un tableau (a toi de trouver une séquence de rupture entre tes blocs : par exemple, l'apparition d'une date en bout de ligne semble indiqué le debut d'un nouveau bloc).
Ensuite il te faudra quelques instructions de traitement de chaine de caractères : Left, Mid, Right, Replace, Split

CR

crenaud76 · Answer

Au vu des produit recherché, tu travailles pour la société "Tour de France" non ?

waspy59 · Answer

bonjour,



merci pour vos reponses rapides, je vais faire des essais en analysant
bloc par bloc.... je pense que le bloc du type "E N1-1" ou la date peut
etre un bon delimiteur.



Pour info je bosse dans le diagnostic biologiques (medoc, drogues) mais
je ne bosse pas pour la soci&#233;t&#233; "Tour de France".... on n'a pas de test
de detection de l'EPO... pas encore. 



a bientot

waspy59 · Answer

au fait, je suis toujours preneur de vos solutions

FMatrix07 · Answer

Si le fichier est comme tu l'as envoyer essai &#231;a

Public Myxlapp As Excel.Application
Private Sub Command1_Click()
Set Myxlapp = Excel.Application
Myxlapp.Visible = True
Myxlapp.DisplayAlerts = True


Workbooks.Open FileName:=Text2 & Text4, Origin:=xlWindows
    Columns("A:A").Select
    Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    i = ActiveCell.Row
    Val1 = 1
    Workbooks.OpenText FileName:=Text1 & Text3, Origin:=932, StartRow:=1 _
        , DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 2), Array(1, 2), Array(3, 2) _
        , Array(12, 2), Array(26, 2), Array(42, 2), Array(61, 2)), TrailingMinusNumbers:=True
    Do
     Columns("B:B").Select
     Range("B" & Val1).Activate
     Selection.Find(What:="E", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
         :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
         False, SearchFormat:=False).Activate
     Val1 = ActiveCell.Row
     ValPatient = Range("D" & Val1)
     ValMatrice = Range("E" & Val1)
     ValDate = Range("F" & Val1)
     ValHeure = Range("G" & Val1)
     Windows(Text4.Text).Activate
     Range("A" & i) = ValPatient
     Range("B" & i) = ValMatrice
     Range("C" & i) = ValDate
     Range("D" & i) = ValHeure
     Val1 = Val1 + 2
     Windows(Text3.Text).Activate
     Do
      If Range("B" & Val1) = "" Then
       ValAnalyse = Range("C" & Val1)
       ValResult = Range("D" & Val1)
      End If
     Windows(Text4.Text).Activate
     Rows("1:1").Select
     On Error GoTo AddColumn
     Err.Clear
     Selection.Find(What:=ValAnalyse, After:=ActiveCell, LookIn:=xlFormulas, _
         LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
         MatchCase:=False, SearchFormat:=False).Activate
     GoTo JumpAddColumn
AddColumn:
     Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, _
         LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
         MatchCase:=False, SearchFormat:=False).Activate
     ValC1 = ActiveCell.Column
     Cells(1, ValC1) = ValAnalyse
     Err.Clear
JumpAddColumn:
     ValC1 = ActiveCell.Column
     Cells(i, ValC1) = ValResult
     Val1 = Val1 + 1
     Windows(Text3.Text).Activate    Loop Until Range("B" & Val1) "" And Range("C" & Val1) ""
    i = i + 1
    Range("B" & Val1).Activate
   Loop Until Range("B" & Val1 + 2) = ""
   Windows(Text3.Text).Activate
   ActiveWindow.Close
   Columns("A:D").Select
   With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
   End With
   With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
   End With
   Columns("A:A").Select
   With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
   End With
   Range("A1").Select
   With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
   End With
   Range("A1").Select
   ActiveWorkbook.Save
   ActiveWorkbook.Close
On Error GoTo Jumping1
Myxlapp.Visible = True
Myxlapp.DisplayAlerts = True
Myxlapp.Quit
Set Myxlapp = Nothing
Jumping1:
End
End Sub

FMatrix07 · Answer

&#231;a n'est pas lisible je t'envoi la source
FMATRIX07

waspy59 · Answer

merci FMatrix07



ta source m'est d'un grand secour....mais pourrais tu la commenter si
tu as le temps car j'aimerai comprendre son fonctionnement.

merci

FMatrix07 · Answer

Pas de pb demain je t'envoi &#231;a

waspy59 · Answer

J'ai parl&#233; trop vite.... y a un petit probleme:



ton code ne prend pas compte des patient ayant un "N" devant.mais ce
que je veux c prendre en compte les patients ayant "E" ou "N" devant
sauf ceux pr&#233;c&#233;d&#233;s d'un "I".



Dans mon exemple au dessus seul le patient  "I N  0- 0        61173811   Urine" ne doit pas etre pris en compte.



j'espere avoir &#233;t&#233; clair.



merci

FMatrix07 · Answer

Bonjour on change tout ou presque d'abord ajoute un module nommé "WriteFile.bas" colle ceci dedans Public Function WriteText(FileWrite, ValEntrer) NomFicSrc = FileWrite NomFicDesti = "C:\Tempo2.TMP" 'Ouverture des fichiers NumFicSrc = FreeFile Open NomFicSrc For Input As NumFicSrc NumFicDesti = FreeFile Open NomFicDesti For Output As NumFicDesti Bcle1 = 0 'Lecture/écriture des fichiers Do While Not EOF(NumFicSrc) Line Input #NumFicSrc, msg If msg <> "" Then Print #NumFicDesti, msg next1: Bcle1 = Bcle1 + 1 Loop 'Fermeture des fichiers et ajout de la Valeur d'entrée Print #NumFicDesti, ValEntrer Close #NumFicDesti Close #NumFicSrc 'Changement de nom du fichier Destination Kill NomFicSrc Name NomFicDesti As NomFicSrc End Function Puis change le command1_Click() par ceci Private Sub Command1_Click() 'Declaration du fichier excel Set Myxlapp = Excel.Application Myxlapp.Visible = True Myxlapp.DisplayAlerts = True 'Ouverture du fichier resultatAnalyse Workbooks.Open FileName:=Text2 & Text4, Origin:=xlWindows 'Recherche derniere ligne pour nouvelle entrée Columns("A:A").Select Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ False, SearchFormat:=False).Activate i = ActiveCell.Row Val1 = 1 'Copy du fichier des entrées d'analyse FileCopy Text1 & Text3, Text1 & Text3 & 1 'Ajout d'un carractere pour trouver la fin du fichier WriteText Text1 & Text3 & 1, vbCrLf & "F" 'ouverture du fichier des entrées d'analyse Workbooks.OpenText FileName:=Text1 & Text3 & 1, Origin:=932, StartRow:=1 _ , DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 2), Array(1, 2), Array(3, 2) _ , Array(12, 2), Array(26, 2), Array(42, 2), Array(61, 2)), TrailingMinusNumbers:=True 'Recherche derniere ligne Columns("A:A").Select Range("A" & Val1).Activate Selection.Find(What:="F", After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ False, SearchFormat:=False).Activate ValFin = ActiveCell.Row 'Recherche des differents patient Range("B" & Val1).Activate Do 'Test si c'est une entrée patient different de "I" If Range("B" & Val1) <> "" And Range("A" & Val1) <> "I" Then ValPatient = Range("D" & Val1) ValMatrice = Range("E" & Val1) ValDate = Range("F" & Val1) ValHeure = Range("G" & Val1) Windows(Text4.Text).Activate Range("A" & i) = ValPatient Range("B" & i) = ValMatrice Range("C" & i) = ValDate Range("D" & i) = ValHeure Windows(Text3.Text & 1).Activate Val1 = Val1 + 2 'Recherche de la type et valeur analyse Do If Range("B" & Val1) = "" Then ValAnalyse = Range("C" & Val1) ValResult = Range("D" & Val1) End If Windows(Text4.Text).Activate 'Recherche position colonne analyse si erreur test abs alors ajout de la colonne Rows("1:1").Select On Error GoTo AddColumn Err.Clear Selection.Find(What:=ValAnalyse, After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate GoTo JumpAddColumn AddColumn: Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ValC1 = ActiveCell.Column Cells(1, ValC1) = ValAnalyse Err.Clear JumpAddColumn: 'Ajout des valeur d'analyse pour le patient ValC1 = ActiveCell.Column Cells(i, ValC1) = ValResult Windows(Text3.Text & 1).Activate Val1 = Val1 + 1 Loop Until Range("B" & Val1) "" And Range("C" & Val1) "" i = i + 1 Else Val1 = Val1 + 1 End If Loop Until Val1 >= ValFin Windows(Text3.Text & 1).Activate ActiveWindow.Close 'Mise en forme du classeur resultat analyse Columns("A:D").Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Columns("A:A").Select With Selection .HorizontalAlignment = xlLeft .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Range("A1").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Range("A1").Select 'Sauvegarde du fichier puis fermeture ActiveWorkbook.Save ActiveWorkbook.Close 'Effacer la copie fichier entrée analyse Kill Text1 & Text3 & 1 'Liberer excel On Error GoTo Jumping1 Myxlapp.Visible = True Myxlapp.DisplayAlerts = True Myxlapp.Quit Set Myxlapp = Nothing Jumping1: End End Sub ***************************************** Il y a un seul Bug je n'ai pas trouvé comment resoudre quand il manque plus d'un type d'analyse dans la classeur ResultAnalyse ça plante le premier et bien ajouté mais si il y en a un deuxieme malgre le err.clear ça plante A toi de jouer

galopin01 · Answer

bonsoir,
Je t'ai envoy&#233; plusieurs r&#233;ponses successives par mail et sur un pr&#233;c&#233;dent topic.
Je gal&#232;re un peu avec ma messagerie. As-tu re&#231;u ces messages ?
Je te remet le lien de ma derni&#232;re mouture ici
A +

waspy59 · Answer

bonsoir galopin01, g bien recu tes mails et c ok, merci pour ton aide.



sinon Fmatrix07, ton prog ca roule aussi mais g juste un pb: je l'ai
fais sous vb6, excel 11 et windows xp sp2 mais je dois utiliser ce prog
avec un windows nt4 et excel 98 ou 2000.

Or le prog compil&#233; ne fonctionne pas avec cette derniere config.... comment faire pour resoudre ce probleme.



merci

FMatrix07 · Answer

Il n'y pas de possiblit&#233; que de compiler sous le m&#234;me OS et pack office
au cas ou tu peux m'envoyer tes fichiers je te ferai la compilation j'ai ce qu'il faut
@+

FMatrix07 · Answer

Si tu ne peux m'envoyer tes sources tu peux toujours intergrer ce que t'ai envoyer dans une macro excel en attribuant les variables de chemin et de nom fichier a des cellules de ton classeur puis lance la macro &#224; l'ouverture de ton classeur.

Sinon envoi tes fichiers y pas de pb
@+

waspy59 · Answer

bojour fmatrix07,



comme tu me l'as demand&#233;, je t'es envoy&#233;s la source du prog.



je te remercie beaucoup de ton aide, tu me retire une epine du pied.



@+

FMatrix07 · Answer

je ne les ai pas recus

Excel et fichier text.........la galere

18 réponses

Discussions similaires