csv naar layout

[xbox360]

Hoi,

ik had reeds een mooie vba code gehad om geruimd en schoon te splitsen en dan in me excel lijst kon knippen en plakken dus dat werkt perfect
nu maak ik een export csv van onze collega`s die een app hebben om gegevens vast te leggen voor bij plaatsing
dat is ruwe date en dan moet ik meerde cellen knippen of verwijderen om tot een eind resultaat te komen zoals in blad 1
is het mogen dan ik van een dag date soms 90 regels deze in export csv te plakken en in blad1 het eind resultaat krijg?

Alvast super bedankt:thumb:

 

[Timshel]

Met die paar gevulde cellen in Blad1 wordt echt niet duidelijk hoe het resultaat eruit moet zien.

 

[cow18]

https://www.helpmij.nl/forum/showthread.php/940161-CSV-bestand-bevat-ipv?highlight=csv+file

 

[xbox360]

@Timshel

blad1 is de uitkomst

Wagnerplein staat in de export K1 en moet in Blad1 op A1 komen Bouw&sloop in export Q1 en moet in blad1 op H1 komen.
beetje puzzelen denk dat ik het met = cel ga doen alleen zit ik nog met de export met C2 hoe ik deze met een formule in blad1 in cel E en F krijg :d

 

[cow18]

zo?

 

[xbox360]

@cow18

Perfect, alleen moet schoon en geruimd gesplitst worden
Wagnerplein was schoon
Mascagnistraat is geruimd

nu staat heel cel E en F het zelfde
Maar het is al super bij deze alvast bedankt

 

[cow18]

een extra loopje voor je wegschrijft naar je csv-file (zie rood)
Wilde je de header er ook bij in die file dan moet je in de 2e rij die rode 2 in een 1 veranderen en in de nieuwe loop die for i=1 to ubound(sp) die 1 in een 2 veranderen.

Sub Write2CSV()

    sn = Sheets("export csv").Range("A1").CurrentRegion.Resize(, 32)    'lees je gegevens, zoveel rijen en 32 kolommen breed
    sp = Application.Index(sn, Evaluate("ROW([COLOR="#FF0000"]2[/COLOR]:" & UBound(sn) & ")"), Array(11, 32, 32, 13, 3, 3, 25, 17, 19, 23, 31))    'het knutselwerk voor jou zit in die array
    [COLOR="#FF0000"]For i = 1 To UBound(sp)
        If sp(i, 5) = "Schoon" Then sp(i, 5) = ""
        If sp(i, 6) = "Geruimd" Then sp(i, 6) = ""
    Next[/COLOR]

    For i = 1 To UBound(sp)                                          'in een loopje
        s = s & Join(Application.Index(sp, i, 0), ";") & vbLf        'alle regels samenvoegen met ";" als separator en vblf op het einde
    Next

    With Sheets("blad1").Range("A10")                                'deze 4 regels zijn enkel pro forma om te tonen wat je wegschrijft, mogen straks weg
        .Resize(100, 20).ClearContents
        .Resize(UBound(sp), UBound(sp, 2)).Value = sp
    End With

    On Error GoTo fout
    CreateObject("scripting.filesystemobject").createtextfile(ThisWorkbook.Path & "\UitvoerCSV.txt").write s    'wegschrijven naar hier, let op, file mag niet geopend zijn !!!

    Workbooks.OpenText Filename:=ThisWorkbook.Path & "\UitvoerCSV.txt", Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
                       xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False    'tekstfile openen ter controle
    ActiveSheet.UsedRange.EntireColumn.AutoFit
    Exit Sub

fout:
    MsgBox "je tekstfile staat vermoedelijk nog open !!!" & vbLf & "Wegschrijven mislukt", vbCritical

End Sub

 

[xbox360]

@cow18

:thumb::thumb::thumb::thumb::thumb: precies wat ik bedoel
ik wil je SUPER bedanken, dit bespaar me echt super veel tijd