txt bestand gedeeltelijk importeren

[Gerald Baalhuis]

Bijgaand een txt bestand met lange regels tekst/getallen(getallen als tekst).
Het is een patientenbestand (alle letters vervangen door 'x'.
Op elke regel staat een patient, patientgegevens en welke medicatie hij/zij op welk tijdstip krijgt.
De medicatie wordt met een 8-cijferig getal aangeduid (MMMMMMMM in de legenda)
Het aantal tabletten/capsules van die medicatie staat er direct voor (n).
Er kunnen, zoals je ziet, meerdere medicaties op één regel staan.
Er staan ook wat vreemde tekens in de regel, volgens mij een code voor einde regel/volgende regel.

In de onderste regel heb ik een soort legenda gemaakt:
'-' teken: hoeft niet geimporteerd
"uu" : tijdstip inname
"jjmmdd" startdatum inname/stopdatum iname
"n" : aantal in te nemen tabletten op tijdstip "uu"
"MMMMMMMM": NDC of medicatienummer

Ik wil graag automatisch alle "n" en "MMMMMMMM" items van alle regels in een excelblad importeren.

Kan dit met een macro of VBA, dit kan wel met de Wizard, maar dan moet ik het telkens handmatig aangeven.

Voorbeeld bestand is slechts een klein voorbeeld met 24 regels.
In totaal verwerken wij per dag zo'n 100.000 regels.

Naast dit txt bestand krijgen we ook *.dat bestanden binnen, deze bevatten soortgelijke regels met tekst, maar als ik snap hoe het bij *.txt bestanden kan, vogel ik zelf wel uit hoe dat bij *.dat bestanden kan.

 

[plagvreugd]

Hallo Gerald,

Zoals je zelf al aangeeft kunnen er meerdere medicaties op 1 regel staan. De eerste medicatie op een regel noem je in je legenda nMMMMMMMM, de andere medicaties noem je ABBBBBBBB. Wil je deze andere medicaties ook importeren?

Volgens mij kun je gewoon een macro opnemen waarin je de gegevens uit het tekstbestand importeert en de overbodige kolommen verwijdert.

Zie bijgevoegd bestand.

 

[Gerald Baalhuis]

Je hebt gelijk, ik was vergeten de BAAAAAAAA te verandren in nMMMMMMMM
Ik wil ze allemaal importeren.
Ik zal eens proberen of dat met een macro opnemen gaat.

Alvast bedankt.

Gerald

 

[plagvreugd]

Ok ben benieuwd, de macro van mijn eerder bijgevoegde bestand werkte iig ok.

 

[Gerald Baalhuis]

Sorry,

Had ik nog niet eens gezien
Ga ik meteen proberen, ik zie meteen alweer iets anders, want alle afzonderlijke medicaties zouden onder elkaar moeten komen (dus als er 7 medicaties op één regel staan, zou ik het liefst 7 regels krijgen met elk twee gegevens: aantal en NDC nummer.
Daarna nog eens de dubbele eruit.

Maar eerst ga ik jouw marco proberen!!!

Thanks,


Gerald

 

[Gerald Baalhuis]

Beste plagvreugd,

De macro loopt wel, maar in de regel
"TEXT;C:\Documents and Settings\Administrator\Desktop\helpmij.txt"
wordt het txt bestand niet geopend.....

Ik had het bestand daar al heen verplaatst, maar helaas...

Nog even gekeken in de VBA module, daar het juiste pad opgegeven en nu loopt de macro als een zonnetje.

Nu ga ik nog even uitvogelen hoe de kolommen onder elkaar komen, gesorteerd worden en de dubbele eruit gevist worden (waar dan wel het aantal van opgeteld moet worden bij de eerst voorkomende medicatie....(Als U begrijpt wat ik bedoel....)


Gerald

 

[plagvreugd]

Hm nee eigenlijk niet

Denk dat je maar het best een nieuwe macro kan opnemen dan, zo veel wereldschokkends staat er niet in.
- Import External Data
- Fixed Width
- Heleboel Break Lines verwijderen en op de juiste plaats toevoegen (voor en na n en na MMMMMMMM)
- Verwijderen van de ongewenste kolommen.

Succes,
plagvreugd.

 

[Gerald Baalhuis]

Plagvreugd,

Ik ga verder stoeien, met jouw macro ben ik in elk geval een stuk verder. Bedankt.
Ik laat de vraag nog wel even staan, wellicht kom ik nog iets tegen waar jij of een forum lid een oplossing voor heeft.

Gerald

 

[snb]

Hiermee moet je een eind komen:

Sub tst4()
  Open "E:\OF\0_medicatie.txt" For Input As #1
    sq = Split(Input(LOF(1), #1), vbCrLf)
  Close #1
    
  For j = 0 To UBound(sq) - 1
    For jj = 0 To (Len(sq(j)) - 95) \ 46
      c1 = c1 & Mid(sq(j), 96 + jj * 46, 46) & "|"
    Next
  Next

  sq = Filter(Split(c1, "|"), Chr(3), False)
  Sheets(1).Cells(1, 1).Resize(UBound(sq) + 1) =  WorksheetFunction.Transpose(sq)
End Sub

 

[Gerald Baalhuis]

Hallo SNB,

Hoewel ik er niet veel van snap, denk ik toch dat jouw oplossing de goede kant opgaat.
Ik denk dat ik het 'probleem' niet helemaal goed heb uitgelegd.
Ik hoef alleen de waarden "nMMMMMMMM", die meerdere keren op één regel voor kan komen, te importeren in Excel.
Dus zoals in bijgevoegd aangepaste txt bestand, alleen de nMMMMMMMM posities op elke regel.
Kan je daar wat mee?

Eigenlijk zou dan elke n in een cel moeten komen, en de MMMMMMMM reeks in de cel rechts ervan.

Daarna (wat een wensen, hé) de n cellen met dezelfde MMMMMMMM waarde bij elkaar optellen.

Ik heb ook een voorbeeld excel bestandje bijgevoegd.

Gerald

 

[snb]

Sub tst4()
    Open "E:\OF\0_medicatie.txt" For Input As #1
     sq = Split(Input(LOF(1), #1), vbCrLf)
    Close #1
    
    sn = Sheets(1).Cells(1, 1).Resize(UBound(sq))
    For j = 0 To UBound(sq) - 1
        c1 = ""
        For jj = 0 To (Len(sq(j)) - 95) \ 46 - 1
            c1 = c1 & Left(Right(Trim(Mid(sq(j), 96 + jj * 46, 46)), 9), 1) & "|" & Right(Trim(Mid(sq(j), 96 + jj * 46, 46)), 8) & "|"
        Next
        sn(j + 1, 1) = c1
    Next
    Sheets(1).Cells(1, 1).Resize(UBound(sq)) = sn
    Sheets(1).Columns(1).TextToColumns , 1, -4142, , False, False, False, False, True, "|"
End Sub

 

[Gerald Baalhuis]

Beste Plagvreugd en SNB,

Ik zou graag een bestand willen kiezen ipv dat het in de code expliciet genoemd staat.
Na enig zoeken heb ik wel een code gevonden die de gebruiker een bestand laat kiezen, maar weet (nog) niet hoe ik deze code kan combineren met jullie oplossingen.

In bijgaand txt bestand de code van Internet.

groet,

Gerald

 

[plagvreugd]

Beste Plagvreugd en SNB,
In bijgaand txt bestand de code van Internet.

Belofte maakt schuld...

 

[Warme bakkertje]

Sub tst4()
  Open Application.GetOpenFilename _
    (filefilter:="Text Files(*.txt),*.txt,All Files (*.*),*.*") For Input As #1
     sq = Split(Input(LOF(1), #1), vbCrLf)
    Close #1
    
    sn = Sheets(1).Cells(1, 1).Resize(UBound(sq))
    For j = 0 To UBound(sq) - 1
        c1 = ""
        For jj = 0 To (Len(sq(j)) - 95) \ 46 - 1
            c1 = c1 & Left(Right(Trim(Mid(sq(j), 96 + jj * 46, 46)), 9), 1) & "|" & Right(Trim(Mid(sq(j), 96 + jj * 46, 46)), 8) & "|"
        Next
        sn(j + 1, 1) = c1
    Next
    Sheets(1).Cells(1, 1).Resize(UBound(sq)) = sn
    Sheets(1).Columns(1).TextToColumns , 1, -4142, , False, False, False, False, True, "|"
End Sub

 

[Gerald Baalhuis]

Werkt wederom als een trein!!! Bedankt maar weer, ik kan weer verder stoeien.

Gerald

 

[Warme bakkertje]

Dan mag de vraag nog even op opgelost (rechts onderaan)

 

[Gerald Baalhuis]

Oopps

Bij deze op opgelost.

Bedankt voor de waarschuwing.

Gerald

 

[Gerald Baalhuis]

warme Bakkertje,

toch nog even op niet opgelost.
Zie jij (of snb of plagvreugd) kans ditze;fde trucje voor *.dat bestanden te programmeren?
Ik heb een voorbeeld bijgevoegd (eerst hernoemen naar *.dat)
in eerste regel is het gewenste getal in rood aangegeven. In alle volgende regels staat het getal op dezelfde posities.

Dit is een deel van de code die ik via een macro opgenomen heb en het tweede gedeelte is van de reeds bestaande oplossing voor *.txt files.

Sub Macro1()
'
' Macro1 Macro
'

'
    Sheets("Batch Import blad").Select
    'ChDir "C:\Documents and Settings\Erik.BAALTJE\Bureaublad"
    ' Hieronder dus de gebruiker de keuze laten maken;
    Workbooks.OpenText Filename:= _
        "C:\Documents and Settings\Erik.BAALTJE\Bureaublad\bever08022.dat", Origin:= _
        xlMSDOS, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 9) _
        , Array(78, 1), Array(86, 9)), TrailingMinusNumbers:=True
    ActiveCell.Select
    
    'zoals het met het txt file gedaan wordt:
    'Open Application.GetOpenFilename _
    '(filefilter:="Text Files(*.txt),*.txt,All Files (*.*),*.*") For Input As #1

Is het mogelijk dat bijv de extensie van het bestand wordt gelezen en aan de hand daarvan de import geschiedt? Of is dat al te mooi gedacht?

Gerald