• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Het schrijven van diverse celinhoud naar txt bestand

Status
Niet open voor verdere reacties.

Jeroen123456

Gebruiker
Lid geworden
3 jul 2007
Berichten
115
Ik probeer een vba code te schrijven die de inhoud van diverse cellen in een excel blad te schrijven naar een txt bestaand.

het bestand kent een aantal cellen onder elkaar, maar ook een aantal cellen (variabel) opzij.
Iedere cell moet een volgende regel in het text bestand zijn.

In bijlage een voorbeeld bestand waar een en ander hopelijk duidelijk wordt.

groetjes, Jeroen
 

Bijlagen

Beginnen de gegevens altijd in B2?
Zijn het altijd de rijen 5 en 6 die meerder gevulde cellen kunnen hebben?
Zijn het altijd 10 rijen?
 
Dit is slechts een voorbeeld, maar

aantal regels altijd het zelfde
Het komt 2x voor dat altijd dezelfde regels 1 tot "X" kolommen opzij kunnen gaan.
Dit moet in het text bestand dan weer allemaal onder elkaar komen.

Ik bouw een json export bestand op waarvoor in excel de data word gevuld.
1 aangifte declaratie (altijd zelfde aantal regels), een routing met 1 of meer landen (op altijd dezelfde regels - 1 tot 4 opzij) en een goederen declaratie met 1 of meer goederen regels (altijd op dezelfde regels - 1 tot 20 opzij).
 
Zo ja, dan kom je hier een heel eind mee:
Code:
Sub Exporteer()
    Dim FSO
    Dim objFile
    Dim arr
    Dim r As Long
    Dim k As Long
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = FSO.CreateTextFile(ActiveWorkbook.Path & "\test.txt")
    arr = Cells(2, 2).CurrentRegion
    For r = 1 To 3
        objFile.Writeline arr(r, 1)
    Next
    For k = 1 To UBound(arr, 2)
        objFile.Writeline arr(4, k)
        objFile.Writeline arr(5, k)
    Next
    For r = 6 To 10
        objFile.Writeline arr(r, 1)
    Next
    objFile.Close
    MsgBox "Resultaat in " & ActiveWorkbook.Path & "\test.txt"
End Sub
 
Laatst bewerkt:
Op basis van jouw voorbeeldbestand.

Code:
Sub M_snb()
  sn = Cells(2, 2).CurrentRegion
  
  For j = 1 To UBound(sn)
     c00 = c00 & vbLf & Replace(Trim(Join(Application.Index(sn, j))), " ", vbLf)
  Next
  
  CreateObject("scripting.filesystemobject").createtextfile("G:\OF\json.txt").write c00
End Sub
 
@snb
Elegant, maar geeft helaas niet het gewenste resultaat.
 
dan maar zo:

Code:
Sub M_snb()
  sn = Cells(2, 2).CurrentRegion
  
  For jj = 1 To UBound(sn, 2)
    sn(4, jj) = sn(4, jj) & vbLf & sn(5, jj)
  Next

  For j = 1 To UBound(sn)
     If j <> 5 Then c00 = c00 & vbLf & Replace(Trim(Join(Application.Index(sn, j))), " ", vbLf)
  Next
  
  CreateObject("scripting.filesystemobject").createtextfile("G:\OF\json.txt").write c00
End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan