Geplaatst op 15 mei 2014

Het probleem is het volgende.
Er staan gegevens in een cel en de opmaak van de cel staat op tekst terugloop ingesteld. Hierdoor staan er meerdere regels gegevens in 1 cel. Deze gegevens wil je splitsen naar andere cellen. Dit is een voorbeeld van de situatie:

Sla het bestand op als temp.csv, in de lokatie:
C:\temp\temp.csv
Let op ! ! ! Bestandsextensie is dus .csv.
Je krijgt dan het volgende bestand als je dit opent in de gratis te downloaden tekstverwerker Notepad++

Neem onderstaande code op in een nieuwe werkmap

Let op ! ! ! TEST eerst in een kopie van je werkmap. Je weet nooit of het mis gaat en dan ben je je gegevens kwijt
1. Kopieer de onderstaande code
2. Open een nieuwe werkmap
3. Druk op de toetscombinatie ALT + F11 om de Visual Basic Editor te openen
4. Druk op de toetscombinatie ALT + N om het menu Invoegen te openen
5. Druk op M om een standaard module in te voegen
6. Daar waar de cursor knippert voeg je de code in middels Ctrl + V
7. Druk op de toetscombinatie ALT + Q om de Editor af te sluiten en terug te keren naar Excel
8. Druk op de toetscombinatie ALT + F8 om de Macro Dialoog te tonen. Dubbeklik op de macro naam om te starten.

Sub Lees_CSV_Bestand()
Dim lngBestandNr As Long, lngRij As Long, varRij As Variant
Dim strTotaal As String, strRijen() As String, strVeld() As String
 
 
    'Freefile gives an integer
    lngBestandNr = FreeFile
    
    'Open the right file, watch location ! ! !
    Open "C:\temp\temp.csv" For Binary As #lngBestandNr
    
    'Space function gives a string with spaces.
    strTotaal = Space(LOF(lngBestandNr))
    
    'Read the dataset
    Get #lngBestandNr, , strTotaal
    
    'Close
    Close #lngBestandNr
    
    'Pay attention ! ! !
    'Use Chr(10), Chr(13), vbCr, vbLf, vbCrLf, of vbNewLine
    'Depends what character is used for end of line
    strRijen = Split(strTotaal, vbCrLf) '< < < here use vbCrLf just like in the screen above
    
    'Error handling off
    On Error Resume Next
    lngRij = 1
    x = 1
    
    For Each varRij In strRijen
        'Write data to worksheet cells.
        Cells(lngRij, x) = varRij 'varRij.Resize(, UBound(strVeld) + 1) = strVeld
        x = x + 1
        If x = 7 Then
            x = 1
            lngRij = lngRij + 1
        End If
    Next
    
    'Error handling on.
    On Error GoTo 0
End Sub

Sub Lees_CSV_Bestand()
Dim lngBestandNr As Long, lngRij As Long, varRij As Variant
Dim strTotaal As String, strRijen() As String, strVeld() As String
 
 
    'Freefile gives an integer
    lngBestandNr = FreeFile
    
    'Open the right file, watch location ! ! !
    Open "C:\temp\temp.csv" For Binary As #lngBestandNr
    
    'Space function gives a string with spaces.
    strTotaal = Space(LOF(lngBestandNr))
    
    'Read the dataset
    Get #lngBestandNr, , strTotaal
    
    'Close
    Close #lngBestandNr
    
    'Pay attention ! ! !
    'Use Chr(10), Chr(13), vbCr, vbLf, vbCrLf, of vbNewLine
    'Depends what character is used for end of line
    strRijen = Split(strTotaal, vbCrLf) '< < < here use vbCrLf just like in the screen above
    
    'Error handling off
    On Error Resume Next
    lngRij = 1
    x = 1
    
    For Each varRij In strRijen
        'Write data to worksheet cells.
        Cells(lngRij, x) = varRij 'varRij.Resize(, UBound(strVeld) + 1) = strVeld
        x = x + 1
        If x = 7 Then
            x = 1
            lngRij = lngRij + 1
        End If
    Next
    
    'Error handling on.
    On Error GoTo 0
End Sub

En je krijgt dit als resultaat. De gegevens staan nu in de cellen A1:F1: