Namig: drugi jeziki so prevedeni v Google. Lahko obiščete English različico te povezave.
Vpiši se
x
or
x
x
Registracija
x

or

Kako uvoziti več besedilnih datotek iz mape v en delovni list?

Za primere, tukaj imate mapo z več besedilnimi datotekami, kar želite storiti je, da te tekstovne datoteke uvozite v en delovni list kot pod prikazom zaslona. Namesto kopiranja besedilnih datotek enega po enega, ali obstajajo triki za hitro uvažanje besedilnih datotek iz ene mape v en list?

Uvozite več besedilnih datotek iz ene mape v en list s VBA

Uvozite besedilno datoteko v aktivno celico s programom Kutools for Excel dobra ideja3


dobroIzvozni obseg v datoteko

Kutools za Excel 's Izvozi obseg v datoteko lahko izvozi ali shrani razpon, da ločijo datoteko kot
delovni zvezek, pdf, besedilo, csv ali besedilo.
klik Podjetje > Uvoz / izvoz > Izvozni obseg v datoteko.
doc izvozni obseg celice v datoteko


Tukaj je koda VBA, ki vam lahko pomaga pri uvozu vseh besedilnih datotek iz ene določene mape v nov list.

1. Omogočite delovni zvezek, ki ga želite uvoziti z besedilnimi datotekami, in pritisnite Alt + F11 tipke za omogočanje Microsoft Visual Basic za aplikacije okno.

2. klik Vstavi > Moduli, kopirajte in prilepite pod kodo VBA na Moduli okno.

VBA: uvozite več besedilnih datotek iz ene mape v en list

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. Pritisnite F5 da prikažete pogovorno okno in izberete mapo, ki vsebuje besedilne datoteke, ki jih želite uvoziti. Prikaz slike:
doc uvozi besedilne datoteke iz mape 1

4. klik OK. Potem so bile besedilne datoteke uvožene v aktivni delovni zvezki kot nova lista ločeno.
doc uvozi besedilne datoteke iz mape 2


Če želite uvoziti eno besedilno datoteko v določeno celico ali obseg, lahko uporabite Kutools za ExcelJe Vstavi datoteko na kazalniku uporabnost.

Kutools za Excel, z več kot 120 priročne funkcije Excel, izboljša delovno učinkovitost in prihranite čas dela.

po brezplačna namestitev Kutools za Excel, naredite spodaj:

1. Izberite celico, v katero želite uvoziti besedilno datoteko, in kliknite Podjetje > Uvozno-izvoznih > Vstavi datoteko na kazalniku. Prikaz slike:
doc uvozi besedilne datoteke iz mape 3

2. Potem se odpre pogovorno okno, kliknite Brskanje za prikaz Izberite datoteko , ki se vstavi v pogovorno okno položaja celice, nato izberite Besedilne datoteke na spustnem seznamu in izberite besedilno datoteko, ki jo želite uvoziti. Prikaz slike:
doc uvozi besedilne datoteke iz mape 4

3. klik Odprto > Okin je bila določena besedilna datoteka vstavljena na položaj kazalke, glejte sliko zaslona:
doc uvozi besedilne datoteke iz mape 5


Priporočena orodja za produktivnost za Excel

zavihek kte 201905

Kutools za Excel vam pomaga, da vedno končate delo pred časom in izstopite iz množice

  • Več kot zmogljive napredne funkcije 300, zasnovane za 1500 delovne scenarije, ki povečujejo produktivnost z 70%, vam dajejo več časa za skrb za družino in uživanje v življenju.
  • Ne potrebujete več pomnilniških formul in VBA kod, od zdaj naprej pa dajate svojim možganom počitek.
  • Postanite strokovnjak za Excel v minutah 3, zapletene in ponavljajoče se operacije lahko opravite v nekaj sekundah,
  • Vsak dan zmanjšajte število operacij tipkovnice in miške, zdaj se poslovite od poklicnih bolezni.
  • 110,000 visoko učinkovite ljudi in 300 + svetovno priznanih podjetij izbiro.
  • Brezplačna preizkusna različica 60 dneva. 60-dnevno jamstvo vračila denarja. 2 let brezplačne nadgradnje in podpore.

Prinaša kartično brskanje in urejanje za Microsoft Office, veliko močnejši od zavihkov brskalnika

  • Office Tab je namenjen za Word, Excel, PowerPoint in druge Office aplikacije: Založnik, Dostop, Visio in Projekt.
  • Odprite in ustvarite več dokumentov v novih zavihkih istega okna in ne v novih oknih.
  • Z 50% poveča vašo produktivnost in vsak dan zmanjša na stotine klikov z miško!
Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    pooja · 4 months ago
    hi i want to prevent removing preceding zero's in excel.

    i have tried below code but it is not working


    Sub Test()
    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
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder"
    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))
    ActiveSheet.Cells.NumberFormat = "@" 'This is to make excel in text format before pasting the text file data
    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
    • To post as a guest, your comment is unpublished.
      Sunny · 4 months ago
      Pooja, you can try the Remove Leading Zeros function of Kutools for Excel to remove all leading zeros from selection after importing.
      • To post as a guest, your comment is unpublished.
        pooja · 4 months ago
        but I don't want to remove. I want to prevent from removing preceding zero's.
        • To post as a guest, your comment is unpublished.
          Sunny · 3 months ago
          If you want to keep the leading zeros, you can format them as text format by Cell Format.
  • To post as a guest, your comment is unpublished.
    Harsh · 5 months ago
    How would you delete the sheets in vba code if you dont want duplicates on re-executing the module?
    • To post as a guest, your comment is unpublished.
      Sunny · 4 months ago
      Sorry, Harsh, just be carefull to avoid repeatly importing.
  • To post as a guest, your comment is unpublished.
    John · 8 months ago
    Hi, my code runs but only imports the first file. It says there was a method error for copy. The debugger highlights the following line of code. Any ideas?


    xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
  • To post as a guest, your comment is unpublished.
    Albeer Mayez · 1 years ago
    The Code is very helpful, it is the only code that i found which gets txt files in bulk the fix that i need on it is also what Joyce and Davinder are after.
    It is to extract the .txt files and paste them all under each other in a specific column lets say column 'N'.

    Also, need to know if it will be possible to add an "if condition" for the .txt files imported to be as follow.
    if the .txt files start with letter 'A' then to be pasted on 'sheet 1' starting with cell 'N2'
    and if the .txt files start with letter 'B' then paste on 'Sheet 2' starting with cell 'N2'
    else MsgBox to be "Unrecognised .txt file purpose".

    thank you in advance
    • To post as a guest, your comment is unpublished.
      Sunny · 1 years ago
      Sorry, my hands are tied
    • To post as a guest, your comment is unpublished.
      Albeer Mayez · 1 years ago
      I have this code worked for me but still, I need to change some in it.

      *I want it to paste on the same sheet without opening a new sheet then copy it as it takes longer time.

      *need to insert a conditional if for txt files imported to be pasted on sheet 1 if it starts with letter A and imported to Sheet 2 if it starts with letter B


      Sub testcopy3()
      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 LastRow As Long
      Dim Rng 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
      Range("N2").Select
      Set xToBook = ThisWorkbook
      If xFiles.Count > 0 Then
      For i = 1 To xFiles.Count
      Set xWb = Workbooks.Open(xStrPath & xFiles.Item(i))
      xWb.Activate
      'Selecting and copying the txt data
      Range(Selection, Selection.End(xlDown)).Select
      Selection.Copy
      xToBook.Activate
      ActiveSheet.Paste
      Selection.End(xlDown).Offset(1).Select
      On Error Resume Next
      On Error GoTo 0
      xWb.Close False
      Next
      End If
      End Sub
  • To post as a guest, your comment is unpublished.
    Joyce · 1 years ago
    When I run the module as given, it adds each .txt file as a new sheet, not as a new line to the existing sheet. Is there a way to achieve that as the output instead of new sheets for each .txt file?