importeren meerdere .txt bestanden uit 1 file

[greetings]

Hallo allen,
ik wil graag meerdere .txt bestanden importeren in Excel, zodat de kolommen van de txt bestanden naast elkaar worden weergegeven op 1 excel blad.
De .txt bestanden bestaan uit 2 kolommen. Alleen de tweede kolom is van belang. Als de 1e kolom ook telkens wordt geïmporteerd moeten deze handmatig worden verwijderd.

Ik de eerste keer importeren opgenomen in een Macro (zie onderaan). Daarbij zijn de instellingen van punten en komma's van belang. Dit leidt tot redelijk wat tekst.

De vraag is:
- Hoe kan ik de macro laten herhalen tot en met de laatste .txt in de map?
- Hoe kan ik alleen kolom 2 importeren?

Macro:

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;G:\IR\van Gerjen\witte bollen selectie\witte bollen 125-250 um\65-1.txt" _
, Destination:=Range("$A$1"))
.Name = "65-1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1)
.TextFileThousandsSeparator = ","
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Application.Goto Reference:="importeren"
End Sub

 

[VenA]

Kan je even een voorbeeldje van jouw tekstbestandje plaatsen? En waarom wil je de gegevens naast elkaar hebben? Het lijkt mij logischer om gegevens onder elkaar te importeren.

 

[greetings]

Die rangschikking is van belang voor verdere statistische dataverwerking (niet met excel). Zo ook de scheiding van decimalen met een punt.
Bijgaand een voorbeeld van 2 geïmporteerde bestanden.

Bekijk bijlage voorbeeld helpmij.xlsx

 

[VenA]

Dus bij de eerste import moeten beide kolommen geïmporteerd worden. En bij elk volgend bestandje alleen de tweede kolom? Je hebt het over scheiding van decimalen met een punt. In het voorbeeldje staat een komma.

Dus als je even een voorbeeldje van een bestand dat je wil importen wil plaatsen dan hoef ik niet zoveel vragen te stellen.:d

 

[greetings]

Vergeet de punten en de komma's..... da's een handeling voor mij bij het importeren want ik gebruik Amerikaanse getalnotatie. Jouw excel maakt er netjes komma's van.

De opbouw van de .txt bestanden is allemaal hetzelfde. Dus 2 kolommen van exact dezelfde lengte, waarbij de reeks data in de eerste kolom altijd hetzelfde is. Het gaat om de waarden bij de tweede kolom. Uiteindelijk is het doel om 1x de eerste kolom en daarna een hele reeks van de tweede kolommen te presenteren. Als de eerste import (met dus 2 kolommen) lastig is, dan is het niet zo veel werk om die ene kolom er later voor te zetten.

Bijgaand een .txt voorbeeld

 

[greetings]

@ VenA

toch lastig om de macro repeterend te maken of ben je het vragen stellen moe

 

[greetings]

het is gelukt om de data gelijk in te lezen in het statistisch programma.

 

[VenA]

@greetings, Mooi dat het lukt om het direct in te lezen.

Ik was wel bezig met jouw vraag maar in één van de bestanden waarin ik code gebruik om tekstbestanden te importeren kwam ik een fout tegen en nogal wat "ongelukkige" code en dat kreeg de voorrang boven jouw vraag:d

Mocht je het toch via excel willen/moeten kan het met deze.

Sub Importeer()
sPath = "U:\Exceltools\WSTest\"
i = 1
Set fc = CreateObject("Scripting.FileSystemObject").GetFolder(sPath).Files
Application.ScreenUpdating = False
For Each f In fc
    If UCase(Right(f, 4)) = ".TXT" Then
        ar = Split(Replace(CreateObject("scripting.filesystemobject").opentextfile(f).readall, Chr(32), " "), vbCrLf)
        If i = 1 Then
            Cells(1).Resize(UBound(ar) + 1) = Application.Transpose(ar)
            Columns(i).TextToColumns , , , , 0, 0, 0, -1, , , , ".", ","
        Else
            Cells(1, i + 1).Resize(UBound(ar) + 1) = Application.Transpose(ar)
            Columns(i + 1).TextToColumns , , , , 0, 0, 0, -1, , , , ".", ","
            Columns(i + 1).EntireColumn.Delete
        End If
    End If
   i = i + 1
Next f
Application.ScreenUpdating = False
End Sub

Even het pad aanpassen naar de locatie waar jouw bestanden staan.

 

[greetings]

Bedankt!
Het is in dit geval een voordeel gebleken om het gelijk in te lezen. Maar ook dat ging niet zonder slag of stoot. Ik ga sowieso nog met jouw macro proberen want op andere momenten zou zomaar ook dezelfde behoefte kunnen ontstaan.