Note: The other languages of the website are Google-translated. Back to English

Hoe importeer ik meerdere tekstbestanden uit een map in één werkblad?

Hier heb je bijvoorbeeld een map met meerdere tekstbestanden, wat je wilt doen is deze tekstbestanden in een enkel werkblad importeren, zoals onderstaand screenshot laat zien. Zijn er in plaats van de tekstbestanden een voor een te kopiëren, trucs om de tekstbestanden snel van de ene map naar een blad te importeren?

Importeer meerdere tekstbestanden uit één map in één blad met VBA

Importeer een tekstbestand naar de actieve cel met Kutools voor Excel goed idee 3


Hier is een VBA-code die u kan helpen bij het importeren van alle tekstbestanden van een specifieke map naar een nieuw blad.

1. Schakel een werkmap in waarvan u tekstbestanden wilt importeren, en druk op Alt + F11 toetsen om in te schakelen Microsoft Visual Basic voor toepassingen venster.

2. klikken Invoegen > Module, kopieer en plak onderstaande VBA-code in het Module venster.

VBA: importeer meerdere tekstbestanden van één map naar één blad

Sub Test()
'UpdatebyExtendoffice6/7/2016
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xWb.Name
            On Error GoTo 0
            xWb.Close False
        Next
    End If
End Sub

3. druk op F5 om een ​​dialoogvenster weer te geven en selecteer een map die tekstbestanden bevat die u wilt importeren. Zie screenshot:
doc tekstbestanden importeren uit een map 1

4. klikken OK. Vervolgens zijn de tekstbestanden afzonderlijk als nieuw blad in de actieve werkmap geïmporteerd.
doc tekstbestanden importeren uit een map 2


Als u één tekstbestand naar een specifieke cel of een specifiek bereik wilt importeren, kunt u zich aanmelden Kutools for Excel's Voeg bestand in bij cursor utility.

Kutools for Excel, met meer dan 300 handige functies, maakt uw werk eenvoudiger. 

Na gratis installeren Kutools voor Excel, doe het als volgt:

1. Selecteer een cel waarvan u het tekstbestand wilt importeren en klik op Koetools Plus > Importeren / exporteren > Voeg bestand in bij cursor. Zie screenshot:
doc tekstbestanden importeren uit een map 3

2. Vervolgens verschijnt er een dialoogvenster, klik op Blader om de Selecteer een bestand om in het dialoogvenster van de celcursorpositie in te voegen, selecteert u vervolgens Tekstbestanden uit de vervolgkeuzelijst en kies vervolgens het tekstbestand dat u wilt importeren. Zie screenshot:
doc tekstbestanden importeren uit een map 4

3. klikken Openen > Ok, en het opgegeven tekstbestand is op de cursorpositie ingevoegd, zie screenshot:
doc tekstbestanden importeren uit een map 5


De beste tools voor kantoorproductiviteit

Kutools voor Excel lost de meeste van uw problemen op en verhoogt uw productiviteit met 80%

  • visfuik: Snel invoegen complexe formules, grafieken en alles wat je eerder hebt gebruikt; Versleutel cellen met wachtwoord; Maak een mailinglijst en stuur e-mails ...
  • Super Formula-balk (bewerk eenvoudig meerdere regels tekst en formule); Lay-out lezen (gemakkelijk grote aantallen cellen lezen en bewerken); Plakken in gefilterd bereik...
  • Voeg cellen / rijen / kolommen samen zonder gegevens te verliezen; Gespleten cellen inhoud; Combineer dubbele rijen / kolommen... Voorkom dubbele cellen; Vergelijk Ranges...
  • Selecteer Dupliceren of Uniek Rijen; Selecteer lege rijen (alle cellen zijn leeg); Super zoeken en fuzzy zoeken in veel werkboeken; Willekeurige selectie ...
  • Exacte kopie Meerdere cellen zonder de formuleverwijzing te wijzigen; Maak automatisch verwijzingen naar meerdere bladen; Plaats kogels, Selectievakjes en meer ...
  • Extraheer tekst, Tekst toevoegen, Verwijderen op positie, Ruimte verwijderen; Paging-subtotalen maken en afdrukken; Converteren tussen celinhoud en opmerkingen...
  • Super filter (bewaar en pas filterschema's toe op andere bladen); Geavanceerd sorteren per maand / week / dag, frequentie en meer; Speciaal filter door vet, cursief ...
  • Combineer werkmappen en werkbladen; Tabellen samenvoegen op basis van sleutelkolommen; Gegevens splitsen in meerdere bladen; Batch Converteer xls, xlsx en PDF...
  • Meer dan 300 krachtige functies. Ondersteunt Office / Excel 2007-2021 en 365. Ondersteunt alle talen. Eenvoudig te implementeren in uw onderneming of organisatie. Volledige functies Gratis proefperiode van 30 dagen. 60 dagen geld-terug-garantie.
kte tabblad 201905

Office-tabblad Brengt een interface met tabbladen naar Office en maakt uw werk veel gemakkelijker

  • Schakel bewerken en lezen met tabbladen in Word, Excel, PowerPoint in, Publisher, Access, Visio en Project.
  • Open en maak meerdere documenten in nieuwe tabbladen van hetzelfde venster in plaats van in nieuwe vensters.
  • Verhoogt uw productiviteit met 50% en vermindert honderden muisklikken voor u elke dag!
officetab onderkant
Heb je vragen? Stel ze hier. (46)
Rated 4 uit 5 · 1 ratings
Deze opmerking is gemaakt door de moderator op de site
Subtest ()
'Bijwerken door'Extendoffice6 / 7/ 2016
Dim xWb als werkmap
Dim xToBook als werkboek
Dim xStrPath als string
Dim xFileDialog als FileDialog
Dim xFile als string
Dim xFiles als nieuwe collectie
Dim ik zo lang
Stel xFileDialog = Application.FileDialog (msoFileDialogFolderPicker) in
xFileDialog.AllowMultiSelect = Onwaar
xFileDialog.Title = "Selecteer een map [Kutools for Excel]"
Als xFileDialog.Show = -1 Dan
xStrPath = xFileDialog.SelectedItems(1)
End If
Als xStrPath = "" Sub afsluiten
If Right(xStrPath, 1) <> "\" Dan xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
If xFile = "" Dan
MsgBox "Geen bestanden gevonden", vbInformation, "Kutools voor Excel"
Exit Sub
End If
Doen terwijl xFile <> ""
xFiles.Voeg xFile, xFile toe
xBestand = Dir()
Ringleiding
Stel xToBook = ThisWorkbook in
Als xFiles.Count > 0 Dan
Voor I = 1 Naar xFiles.Count
Stel xWb = Workbooks.Open(xStrPath & xFiles.Item(I)) in
xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = xWb.Name
On Error GoTo 0
xWb.Sluiten False
Volgende
End If
End Sub

deze code helpt, maar ik wil

tab, puntkomma, spatie true hoe dit te doen help me alstublieft
Deze opmerking is gemaakt door de moderator op de site
Wilt u de spatie (scheidingstekens) behouden na het converteren van de tekstbestanden naar bladen?
Deze opmerking is gemaakt door de moderator op de site
dat is ook mijn probleem, deze code is waar. maar na het converteren van tekstbestanden naar Excel, worden de scheidingstekens niet behouden.
Deze opmerking is gemaakt door de moderator op de site
Zou je het tekstbestand en het gewenste resultaat voor mij kunnen uploaden?
Deze opmerking is gemaakt door de moderator op de site
Ik heb hetzelfde probleem. De txt-bestanden staan ​​allemaal in aparte bladen en de code negeert de ruimte tussen de twee kolommen
Deze opmerking is gemaakt door de moderator op de site
Hallo, Des en PB Rama Murty, de onderstaande code kan gegevens in kolommen splitsen op basis van spatie of tab tijdens het importeren van een tekstbestand naar bladen. Je kunt het proberen.

Sub ImportTextToExcel()
'Bijwerken door'Extendoffice20180911
Dim xWb als werkmap
Dim xToBook als werkboek
Dim xStrPath als string
Dim xFileDialog als FileDialog
Dim xFile als string
Dim xFiles als nieuwe collectie
Dim ik zo lang
Dim xIntRow zo lang
Dim xFNum, xFArr Zo Lang
Dim xStrValue als tekenreeks
Dim xRg als bereik
Dim xArr
Stel xFileDialog = Application.FileDialog (msoFileDialogFolderPicker) in
xFileDialog.AllowMultiSelect = Onwaar
xFileDialog.Title = "Selecteer een map [Kutools for Excel]"
Als xFileDialog.Show = -1 Dan
xStrPath = xFileDialog.SelectedItems(1)
End If
Als xStrPath = "" Sub afsluiten
If Right(xStrPath, 1) <> "\" Dan xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
If xFile = "" Dan
MsgBox "Geen bestanden gevonden", vbInformation, "Kutools voor Excel"
Exit Sub
End If
Doen terwijl xFile <> ""
xFiles.Voeg xFile, xFile toe
xBestand = Dir()
Ringleiding
Stel xToBook = ThisWorkbook in
On Error Resume Next
Application.ScreenUpdating = False
Als xFiles.Count > 0 Dan

Voor I = 1 Naar xFiles.Count
Stel xWb = Workbooks.Open(xStrPath & xFiles.Item(I)) in
xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.Sluiten False
xIntRow = ActiveCell.CurrentRegion.Rows.Count
Voor xFNum = 1 Naar xIntRow
Stel xRg = ActiveSheet.Bereik in ("A" & xFNum)
xArr = Splitsen(xRg.Text, " ")
Als UBound(xArr) > 0 dan
Voor xFArr = 0 Naar UBound(xArr)
Als xArr(xFArr) <> "" Dan
xRg.Waarde = xArr(xFArr)
Set xRg = xRg.Offset(KolomOffset:=1)
End If
Volgende
End If
Volgende
Volgende
End If
Application.ScreenUpdating = True
End Sub
Deze opmerking is gemaakt door de moderator op de site
Welke wijzigingen zijn nodig als u gegevens in kolommen wilt splitsen op basis van komma's?
Deze opmerking is gemaakt door de moderator op de site
Welke wijzigingen moeten worden aangebracht als ik gegevens in kolommen moet plaatsen op basis van komma's?
Deze opmerking is gemaakt door de moderator op de site
Ik heb dit gebruikt en het werkt, maar ik zou graag willen dat alles op één blad wordt opgeslagen, aangezien elk blad dezelfde informatie bevat, het zijn gewoon logbestanden van elke dag.
dus ik moet de combineren
alle items in de map op één blad
Sub ImportCSVsWithReference()
'Updatedoor KutoolsforExcel20151214'
Dim xWb als werkmap
Dim xToBook als werkboek
Dim xStrPath als string
Dim xFileDialog als FileDialog
Dim xFile als string
Dim xFiles als nieuwe collectie
Dim ik zo lang
Dim xIntRow zo lang
Dim xFNum, xFArr Zo Lang
Dim xStrValue als tekenreeks
Dim xRg als bereik
Dim xArr
Bij fout Ga naar ErrHandler
Stel xFileDialog = Application.FileDialog (msoFileDialogFolderPicker) in
xFileDialog.AllowMultiSelect = Onwaar
xFileDialog.Title = "Selecteer een map [Kutools for Excel]"
Als xFileDialog.Show = -1 Dan
xStrPath = xFileDialog.SelectedItems(1)
End If
Als xStrPath = "" Sub afsluiten
If Right(xStrPath, 1) <> "\" Dan xStrPath = xStrPath & "\"
Stel xSht = ThisWorkbook.ActiveSheet in
If MsgBox ("Wis het bestaande blad voordat u importeert?", vbYesNo, "Kutools for Excel") = vbYes Dan xSht.UsedRange.Clear
Application.ScreenUpdating = False
xFile = Dir(xStrPath & "\" & "*.log")
Doen terwijl xFile <> ""
Stel xWb = Workbooks.Open in (xStrPath & "\" & xFile)
ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
xWb.Sluiten False
xBestand = Dir
Ringleiding
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "geen txt-bestanden", "Kutools voor Excel"
End Sub

en deze die spaties gebruikt om aan elke kolom toe te voegen

Sub ImportTextToExcel()
'Bijwerken door'Extendoffice20180911
Dim xWb als werkmap
Dim xToBook als werkboek
Dim xStrPath als string
Dim xFileDialog als FileDialog
Dim xFile als string
Dim xFiles als nieuwe collectie
Dim ik zo lang
Dim xIntRow zo lang
Dim xFNum, xFArr Zo Lang
Dim xStrValue als tekenreeks
Dim xRg als bereik
Dim xArr
Stel xFileDialog = Application.FileDialog (msoFileDialogFolderPicker) in
xFileDialog.AllowMultiSelect = Onwaar
xFileDialog.Title = "Selecteer een map [Kutools for Excel]"
Als xFileDialog.Show = -1 Dan
xStrPath = xFileDialog.SelectedItems(1)
End If
Als xStrPath = "" Sub afsluiten
If Right(xStrPath, 1) <> "\" Dan xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
If xFile = "" Dan
MsgBox "Geen bestanden gevonden", vbInformation, "Kutools voor Excel"
Exit Sub
End If
Doen terwijl xFile <> ""
xFiles.Voeg xFile, xFile toe
xBestand = Dir()
Ringleiding
Stel xToBook = ThisWorkbook in
On Error Resume Next
Application.ScreenUpdating = False
Als xFiles.Count > 0 Dan

Voor I = 1 Naar xFiles.Count
Stel xWb = Workbooks.Open(xStrPath & xFiles.Item(I)) in
xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.Sluiten False
xIntRow = ActiveCell.CurrentRegion.Rows.Count
Voor xFNum = 1 Naar xIntRow
Stel xRg = ActiveSheet.Bereik in ("A" & xFNum)
xArr = Splitsen(xRg.Text, " ")
Als UBound(xArr) > 0 dan
Voor xFArr = 0 Naar UBound(xArr)
Als xArr(xFArr) <> "" Dan
xRg.Waarde = xArr(xFArr)
Set xRg = xRg.Offset(KolomOffset:=1)
End If
Volgende
End If
Volgende
Volgende
End If
Application.ScreenUpdating = True
End Sub
Deze opmerking is gemaakt door de moderator op de site
hoe te doen als mijn Txt-bestand gescheiden door komma's bevat?
Deze opmerking is gemaakt door de moderator op de site
U kunt Zoeken en vervangen fuctuon gebruiken om de komma eerst door spatie te vervangen en een van de bovenstaande methoden toepassen om deze naar een Excel-bestand te converteren.
Deze opmerking is gemaakt door de moderator op de site
Is er geen manier om dit in de code te veranderen? Ik zou dit met 130 bestanden moeten doen
Deze opmerking is gemaakt door de moderator op de site
Zelfde vraag
Deze opmerking is gemaakt door de moderator op de site
Voor degenen die hier nog hulp bij nodig hebben, vervang xArr = Split(xRg.Text, " ") door xArr = Split(xRg.Text, ",").
Deze opmerking is gemaakt door de moderator op de site
Wanneer ik de module uitvoer zoals opgegeven, wordt elk .txt-bestand toegevoegd als een nieuw blad, niet als een nieuwe regel aan het bestaande blad. Is er een manier om dat te bereiken als uitvoer in plaats van nieuwe bladen voor elk .txt-bestand?
Deze opmerking is gemaakt door de moderator op de site
Bedoel je het combineren van alle tekstbestanden op één blad?
Deze opmerking is gemaakt door de moderator op de site
Ja dit is ook wat ik wil.
Deze opmerking is gemaakt door de moderator op de site
Hallo, Davinder, je kunt onderstaande vba-code proberen.
Sub ImportCSVsWithReference()
'UpdatebyKutoolsforExcel20151214
    Dim xSht  As Worksheet
    Dim xWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    On Error GoTo ErrHandler
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    Set xSht = ThisWorkbook.ActiveSheet
    If MsgBox("Clear the existing sheet before importing?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
    Application.ScreenUpdating = False
    xFile = Dir(xStrPath & "\" & "*.txt")
    Do While xFile <> ""
        Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
        ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
        xWb.Close False
        xFile = Dir
    Loop
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox "no txt files", , "Kutools for Excel"
End Sub
Deze opmerking is gemaakt door de moderator op de site
De code is erg handig, het is de enige code die ik heb gevonden die txt-bestanden in bulk krijgt, de oplossing die ik nodig heb, is ook waar Joyce en Davinder naar op zoek zijn.
Het is om de .txt-bestanden uit te pakken en ze allemaal onder elkaar in een specifieke kolom te plakken, laten we zeggen kolom 'N'.

U moet ook weten of het mogelijk is om een ​​"if-voorwaarde" toe te voegen voor de geïmporteerde .txt-bestanden, zodat deze er als volgt uitziet.
als de .txt-bestanden beginnen met de letter 'A', dan worden ze op 'blad 1' geplakt, beginnend met cel 'N2'
en als de .txt-bestanden beginnen met de letter 'B', plak dan op 'Blad 2' beginnend met cel 'N2'
anders moet MsgBox "Niet-herkend .txt-bestandsdoel" zijn.

alvast bedankt
Deze opmerking is gemaakt door de moderator op de site
Ik heb deze code voor mij gewerkt, maar toch moet ik er wat in veranderen.

*Ik wil dat het op hetzelfde blad wordt geplakt zonder een nieuw blad te openen en het vervolgens te kopiëren omdat het langer duurt.

*moet een voorwaarde invoegen als geïmporteerde txt-bestanden op blad 1 moeten worden geplakt als het begint met de letter A en geïmporteerd in blad 2 als het begint met de letter B


Subtestkopie3()
Dim xWb als werkmap
Dim xToBook als werkboek
Dim xStrPath als string
Dim xFileDialog als FileDialog
Dim xFile als string
Dim xFiles als nieuwe collectie
Dim ik zo lang
Dim LaatsteRij Zo Lang
Dim Rng als bereik
Stel xFileDialog = Application.FileDialog (msoFileDialogFolderPicker) in
xFileDialog.AllowMultiSelect = Onwaar
xFileDialog.Title = "Selecteer een map [Kutools for Excel]"
Als xFileDialog.Show = -1 Dan
xStrPath = xFileDialog.SelectedItems(1)
End If
Als xStrPath = "" Sub afsluiten
If Right(xStrPath, 1) <> "\" Dan xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
If xFile = "" Dan
MsgBox "Geen bestanden gevonden", vbInformation, "Kutools voor Excel"
Exit Sub
End If
Doen terwijl xFile <> ""
xFiles.Voeg xFile, xFile toe
xBestand = Dir()
Ringleiding
Bereik ("N2"). Selecteer
Stel xToBook = ThisWorkbook in
Als xFiles.Count > 0 Dan
Voor i = 1 Naar xFiles.Count
Stel xWb = Workbooks.Open(xStrPath & xFiles.Item(i)) in
xWb.Activeren
'Selecteren en kopiëren van de txt-gegevens'
Bereik(Selectie, Selectie.End(xlOmlaag)).Selecteren
Selection.Copy
xToBook.Activeren
ActiveSheet.Paste
Selectie.Einde(xlOmlaag).Offset(1).Selecteren
On Error Resume Next
On Error GoTo 0
xWb.Sluiten False
Volgende
End If
End Sub
Deze opmerking is gemaakt door de moderator op de site
Sorry, mijn handen zijn gebonden
Deze opmerking is gemaakt door de moderator op de site
Hallo, mijn code wordt uitgevoerd, maar importeert alleen het eerste bestand. Er staat dat er een methodefout is opgetreden bij het kopiëren. De debugger markeert de volgende regel code. Om het even welke ideeën?


xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
Deze opmerking is gemaakt door de moderator op de site
Ik heb hetzelfde probleem, al oplossingen gevonden?
Deze opmerking is gemaakt door de moderator op de site
Hey katje,
Ik weet dat je opmerking vrij oud is, maar ik had hetzelfde probleem en heb het op deze manier opgelost: de module moet in een submap van het actieve .xlsx-project worden ingevoegd. Ik heb de fout gemaakt om de code naar een submap van mijn PERSONAL.XLSB te kopiëren, waar ik meestal mijn macro's opsla en dat doet het met mijn andere macro's, maar niet met deze.
Deze opmerking is gemaakt door de moderator op de site
Hoe zou u de bladen in vba-code verwijderen als u geen duplicaten wilt bij het opnieuw uitvoeren van de module?
Deze opmerking is gemaakt door de moderator op de site
Sorry, Harsh, pas op dat u niet herhaaldelijk importeert.
Deze opmerking is gemaakt door de moderator op de site
hallo ik wil voorkomen dat voorafgaande nullen in Excel worden verwijderd.

ik heb onderstaande code geprobeerd maar het werkt niet


Subtest ()
Dim xWb als werkmap
Dim xToBook als werkboek
Dim xStrPath als string
Dim xFileDialog als FileDialog
Dim xFile als string
Dim xFiles als nieuwe collectie
Dim ik zo lang
Dim j zo lang
Stel xFileDialog = Application.FileDialog (msoFileDialogFolderPicker) in
xFileDialog.AllowMultiSelect = Onwaar
xFileDialog.Title = "Selecteer een map"
Als xFileDialog.Show = -1 Dan
xStrPath = xFileDialog.SelectedItems(1)
End If
Als xStrPath = "" Sub afsluiten
If Right(xStrPath, 1) <> "\" Dan xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
If xFile = "" Dan
MsgBox "Geen bestanden gevonden", vbInformation, "Kutools voor Excel"
Exit Sub
End If
Doen terwijl xFile <> ""
xFiles.Voeg xFile, xFile toe
xBestand = Dir()
Ringleiding
Stel xToBook = ThisWorkbook in
Als xFiles.Count > 0 Dan
Voor I = 1 Naar xFiles.Count
Stel xWb = Workbooks.Open(xStrPath & xFiles.Item(I)) in
ActiveSheet.Cells.NumberFormat = "@" 'Dit is om uit te blinken in tekstformaat voordat de tekstbestandsgegevens worden geplakt
xWb.Worksheets(1).Copy After:=xToBook.Sheets(xToBook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = xWb.Name
On Error GoTo 0
xWb.Sluiten False
Volgende
End If
End Sub
Deze opmerking is gemaakt door de moderator op de site
Pooja, je kunt de Verwijder voorloopnullen functie van Kutools for Excel proberen om alle voorloopnullen uit de selectie te verwijderen na het importeren.
Deze opmerking is gemaakt door de moderator op de site
maar ik wil niet verwijderen. Ik wil voorkomen dat voorafgaande nullen worden verwijderd.
Deze opmerking is gemaakt door de moderator op de site
Als u de voorloopnullen wilt behouden, kunt u ze opmaken als tekstformaat met Celopmaak.
Deze opmerking is gemaakt door de moderator op de site
Hallo, hoe wijzig je deze code om *.txt-bestanden in de volgorde in te voegen: 1,2,3,4,5,6,7,8,9,10,11, enz. Momenteel voegt code bestanden als volgt in: 1,10,11,12,13,14,15,16,17,18,19,2,20,21, enz. Bedankt!
Deze opmerking is gemaakt door de moderator op de site
is er een kans om bladnamen alleen een bepaald deel van txt-bestandsnamen te nemen?

volgens bovenstaande code heeft de volledige bladnaam ingenomen.
Deze opmerking is gemaakt door de moderator op de site
heel erg bedankt, heb het werk gedaan op Office 2007 Excel
Deze opmerking is gemaakt door de moderator op de site
Hallo, mijn code wordt uitgevoerd, maar importeert alleen het eerste bestand. Er staat dat er een methodefout is opgetreden bij het kopiëren. De debugger markeert de volgende regel code. Om het even welke ideeën?


xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
Deze opmerking is gemaakt door de moderator op de site
Hé Martinho,
Ik had hetzelfde probleem en loste het op door deze regel te wijzigen:
Stel xToBook = ThisWorkbook in
naar
Stel xToBook = ActiveWorkbook in
Misschien helpt dit.
Deze opmerking is gemaakt door de moderator op de site
0

ik heb je hulp nodig ik heb geen idee vba excel ik wil meerdere tekstbestanden importeren zoals 13000. de tekstbestandsnaam is hetzelfde als de cel bijvoorbeeld (c1=112 dus de tekstbestandsnaam is ook 112) betekent dat het tekstbestand 112 is importeer de c112.
Deze opmerking is gemaakt door de moderator op de site
ik heb je hulp nodig ik heb geen idee vba excel ik wil meerdere tekstbestanden importeren zoals 13000. de tekstbestandsnaam is hetzelfde als de cel bijvoorbeeld (c1=112 dus de tekstbestandsnaam is ook 112) betekent dat het tekstbestand 112 is importeer de c112.
Deze opmerking is gemaakt door de moderator op de site
De code werkt, maar importeert elk tekstbestand naar een nieuw tabblad in de werkmap. Enig idee waar in de code dit kan worden gewijzigd om het nieuwe tekstbestand op hetzelfde werkblad onder de gegevens van het laatste tekstbestand te importeren?
Deze opmerking is gemaakt door de moderator op de site
Als ik in de onderstaande code de map wil specificeren in plaats van het pad te selecteren telkens wanneer een tekstbestand wordt geïmporteerd, welke wijziging moet ik dan doen

VBA-CODE:

Sub ImportCSVsWithReference()
'Updatedoor KutoolsforExcel20151214'
Dim xSht als werkblad
Dim xWb als werkmap
Dim xStrPath als string
Dim xFileDialog als FileDialog
Dim xFile als string
Bij fout Ga naar ErrHandler
Stel xFileDialog = Application.FileDialog (msoFileDialogFolderPicker) in
xFileDialog.AllowMultiSelect = Onwaar
xFileDialog.Title = "Selecteer een map [Kutools for Excel]"
Als xFileDialog.Show = -1 Dan
xStrPath = xFileDialog.SelectedItems(1)
End If
Als xStrPath = "" Sub afsluiten
Stel xSht = ThisWorkbook.ActiveSheet in
If MsgBox ("Wis het bestaande blad voordat u importeert?", vbYesNo, "Kutools for Excel") = vbYes Dan xSht.UsedRange.Clear
Application.ScreenUpdating = False
xFile = Dir(xStrPath & "\" & "*.txt")
Doen terwijl xFile <> ""
Stel xWb = Workbooks.Open in (xStrPath & "\" & xFile)
ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
xWb.Sluiten False
xBestand = Dir
Ringleiding
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "geen txt-bestanden", "Kutools voor Excel"
End Sub
Deze opmerking is gemaakt door de moderator op de site
Hallo, probeer a.u.b. onderstaande code
Sub Test()
'UpdatebyExtendoffice6/7/2016
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    xStrPath = "C:\Users\AddinsVM001\Desktop\test" 'Here is the parth you can modify
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xWb.Name
            On Error GoTo 0
            xWb.Close False
        Next
    End If
End Sub

"C:\Users\AddinsVM001\Desktop\test" is het mappad waaruit u een tekstbestand kunt importeren, wijzig dit indien nodig.
Deze opmerking is gemaakt door de moderator op de site
Hallo, bedankt voor je waardevolle VBA-code.
Ik heb echter een code nodig voor meerdere txt-bestanden in 'een enkel blad in het werkblad, niet een afzonderlijk blad voor elk txt-bestand'.
Wat moet ik uw code voor mijn doel bewerken?

Hartelijk dank,
Deze opmerking is gemaakt door de moderator op de site
Hallo, probeer a.u.b. onderstaande code
Sub Test()
    'UpdatebyExtendoffice 10/26/2022
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    Dim J As Long
    Dim xRg As Range
    Dim xSaveRg As Range
    Dim xSh As Worksheet
    
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    Set xSh = xToBook.Sheets.Add
    Set xRg = xSh.Range("A1")
    J = 1
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            Set xSaveRg = xWb.Worksheets(1).UsedRange
            J = xSaveRg.Rows.Count + 1 + J
            Debug.Print xRg.Address
            xSaveRg.Copy Destination:=xRg
            On Error Resume Next
            xWb.Close False
            
            Set xRg = xSh.Cells(J, 1)
        Next
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Deze opmerking is gemaakt door de moderator op de site
Dit werkt prima. Maar wanneer het importeert, hernoemt het de bladen met naam.txt. Hoe zorg je ervoor dat het alleen de naam behoudt zonder de extensie .txt aan het blad toe te voegen?
Rated 3.5 uit 5
Deze opmerking is gemaakt door de moderator op de site
Ok nvm vond antwoord met google help.
regel vervangen:
ActiveSheet.Name = xWb.Name
met:
ActiveSheet.Name = Links(xWb.Name,Len(xWb.Name)-4)
zou de laatste 4 letters van de bladnaam verwijderen. Effectief me geven wat ik nodig had. naam zonder .txt
Proost
Rated 4 uit 5
Deze opmerking is gemaakt door de moderator op de site
de onderstaande code kan gegevens splitsen in kolommen op basis van spatie of tab tijdens het importeren van tekstbestanden naar bladen. Maar ik wil geen apart tabblad voor elk txt-bestand, ik zou ze allemaal onder één blad willen hebben. De informatie heeft voor elk bestand hetzelfde formaat. . Wat kan worden gewijzigd om ervoor te zorgen dat dit allemaal één blad is in plaats van dat elk geïmporteerd bestand een nieuw tabblad is, alle hulp wordt op prijs gesteld

Sub ImportTextToExcel()
'Bijwerken door'Extendoffice20180911
Dim xWb als werkmap
Dim xToBook als werkboek
Dim xStrPath als string
Dim xFileDialog als FileDialog
Dim xFile als string
Dim xFiles als nieuwe collectie
Dim ik zo lang
Dim xIntRow zo lang
Dim xFNum, xFArr Zo Lang
Dim xStrValue als tekenreeks
Dim xRg als bereik
Dim xArr
Stel xFileDialog = Application.FileDialog (msoFileDialogFolderPicker) in
xFileDialog.AllowMultiSelect = Onwaar
xFileDialog.Title = "Selecteer een map [Kutools for Excel]"
Als xFileDialog.Show = -1 Dan
xStrPath = xFileDialog.SelectedItems(1)
End If
Als xStrPath = "" Sub afsluiten
If Right(xStrPath, 1) <> "\" Dan xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
If xFile = "" Dan
MsgBox "Geen bestanden gevonden", vbInformation, "Kutools voor Excel"
Exit Sub
End If
Doen terwijl xFile <> ""
xFiles.Voeg xFile, xFile toe
xBestand = Dir()
Ringleiding
Stel xToBook = ThisWorkbook in
On Error Resume Next
Application.ScreenUpdating = False
Als xFiles.Count > 0 Dan

Voor I = 1 Naar xFiles.Count
Stel xWb = Workbooks.Open(xStrPath & xFiles.Item(I)) in
xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.Sluiten False
xIntRow = ActiveCell.CurrentRegion.Rows.Count
Voor xFNum = 1 Naar xIntRow
Stel xRg = ActiveSheet.Bereik in ("A" & xFNum)
xArr = Splitsen(xRg.Text, " ")
Als UBound(xArr) > 0 dan
Voor xFArr = 0 Naar UBound(xArr)
Als xArr(xFArr) <> "" Dan
xRg.Waarde = xArr(xFArr)
Set xRg = xRg.Offset(KolomOffset:=1)
End If
Volgende
End If
Volgende
Volgende
End If
Application.ScreenUpdating = True
End Sub
Deze opmerking is gemaakt door de moderator op de site
Hallo, Daniel, probeer onderstaande code, het importeert alle tekstbestanden in één blad met de naam Txt.
Merk op dat: als de tekstnaam hetzelfde is als de bestaande bladnaam, het tekstbestand mogelijk niet wordt geïmporteerd.
Sub ImportTextToExcel2()

'UpdatebyExtendoffice20230106

Dim xWb As Workbook

Dim xToBook As Workbook

Dim xStrPath As String

Dim xFileDialog As FileDialog

Dim xFile As String

Dim xFiles As New Collection

Dim I As Long

Dim xIntRow As Long

Dim xFNum, xFArr As Long

Dim xStrValue As String

Dim xRg As Range

Dim xArr

Dim xRowL, xRowH As Integer

Dim xTxtWS, xWSD As Worksheet

Dim xTxtWS_Rg As Range

Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)

xFileDialog.AllowMultiSelect = False

xFileDialog.Title = "Select a folder [Kutools for Excel]"

If xFileDialog.Show = -1 Then

xStrPath = xFileDialog.SelectedItems(1)

End If

If xStrPath = "" Then Exit Sub

If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"

xFile = Dir(xStrPath & "*.txt")

If xFile = "" Then

MsgBox "No files found", vbInformation, "Kutools for Excel"

Exit Sub

End If

Do While xFile <> ""

xFiles.Add xFile, xFile

xFile = Dir()

Loop

Set xToBook = ThisWorkbook

On Error Resume Next

Set xTxtWS = xToBook.Worksheets("Txt")

If IsNull(xTxtWS) Or IsEmpty(xTxtWS) Then

    Set xTxtWS = xToBook.Worksheets.Add

    xTxtWS.Name = "Txt"

End If

Application.ScreenUpdating = False

Application.DisplayAlerts = False

xTxtWS.Activate

If xFiles.Count > 0 Then

xRowL = 1

For I = 1 To xFiles.Count

Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))

xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)

Set xWSD = xToBook.Sheets(xToBook.Sheets.Count)

xTxtWS.Activate

xWb.Close False

xIntRow = xWSD.UsedRange.CurrentRegion.Rows.Count

    For xFNum = 1 To xIntRow

        Set xRg = xWSD.Range("A" & xFNum)

        xArr = Split(xRg.Text, " ")

        Set xTxtWS_Rg = xTxtWS.Cells.Range("A" & xRowL)

'        If UBound(xArr) > 0 Then

            For xFArr = 0 To UBound(xArr)

                If xArr(xFArr) <> "" Then

                xTxtWS_Rg.Value = xArr(xFArr)

                Set xTxtWS_Rg = xTxtWS_Rg.Offset(ColumnOffset:=1)

                End If

            Next

'        End If

xRowL = xRowL + 1

    Next

xWSD.Delete

Next

End If

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub


Er zijn nog geen reacties geplaatst
Laat uw commentaar
Posten als gast
×
Beoordeel dit bericht:
0   Personages
Voorgestelde locaties

Volg ons

Copyright © 2009 - www.extendoffice.com. | Alle rechten voorbehouden. Aangedreven door ExtendOffice. | Sitemap
Microsoft en het Office-logo zijn handelsmerken of gedeponeerde handelsmerken van Microsoft Corporation in de Verenigde Staten en / of andere landen.
Beschermd door Sectigo SSL