使用vba将多个文本文件导入Excel中的新行？ [英] Import multiple text files to a new row in excel using vba?

问题描述

我有以下代码扫描我的目录文本文件。在我的目录中，有几个文本文件分别如下：

 文本文件：
伯明翰
法国
怀特岛
曼彻斯特
新城堡
  

我然后尝试将每个文本文件导入到excel中的一个新行，以便将每一行文本插入该行中的一个新列。

 伯明翰法国白人曼彻斯特新城堡
  

我已经做了这个代码，但它只导入一个文本文件，而不是导入目录中的所有文本文件。

请问有人会告诉我我哪里错了吗？我应该得到以下结果：

 行1 
伯明翰法国白人曼彻斯特新城堡
 
行2 
伦敦西班牙美国苏顿苏格兰
  

etc ...

代码：

  Sub Import_All_Text_Files_2007（）
 
 Dim nxt_row As Long 
 
'更改路径
 Const strPath As String =Z：\NS\Unactioned\
 Dim strExtension As String 
 
'停止屏幕闪烁
 Application.ScreenUpdating = False 
 
 ChDir strPath 
 
'更改扩展名
 strExtension = Dir（strPath& * .txt）
 
尽管strExtension<> 
 
 
'设置要开始数据的行号
 nxt_row =范围（A1）。End（xlUp）.Offset（0，0）.Row 
 
'以下是从录入的宏导入文本文件
 FileNum = FreeFile（）
 curCol = 1 
打开strPath&输入的strExtension为#FileNum 
虽然不是EOF（FileNum）
行输入#FileNum，DataLine 
 ActiveSheet.Cells（nxt_row，curCol）= DataLine 
 curCol = curCol + 1 
 Wend 
关闭#FileNum 
 
 strExtension = Dir 
循环
 
 Application.ScreenUpdating = True 
 
 End Sub 
  

解决方案

我认为你的问题在这一行： p>

  nxt_row = Range（A1）。End（xlUp）.Offset（0，0）.Row 
  

将其替换为：

  nxt_row = Range（A10000）。End（xlUp）.Offset（1，0）.Row 
  





  if Range（A1）。Value =then 
 nxt_row = 1 
 else 
如果范围（A2）。值=然后
 nxt_row = 2 
 else 
 nxt_row =范围（A1）。 xlDown）.Offset（1）.Row 
 end if 
 end if 
  




I have the following code which scans my directory for text files. In my directory there are several text files each laid out like so:

Text File:
Birmingham
France
Isle of White
Manchester
New-Castle

I am then trying to import each text file to a new row in excel and so that each line of text is inserted into a new column within that row.

Birmingham         France      Isle of White       Manchester     New-Castle

The code I have does this, however it is only importing one text file and is not importing all of the text files in the directory.

Please can someone show me where I am going wrong? I should be getting the following result:

Row 1
Birmingham         France      Isle of White       Manchester     New-Castle 

Row 2
London             Spain       America             Sutton         Scotland

etc...

Code:

Sub Import_All_Text_Files_2007()

    Dim nxt_row As Long

     'Change Path
    Const strPath As String = "Z:\NS\Unactioned\"
    Dim strExtension As String

     'Stop Screen Flickering
    Application.ScreenUpdating = False

    ChDir strPath

     'Change extension
    strExtension = Dir(strPath & "*.txt")

    Do While strExtension <> ""


         'Sets Row Number for Data to Begin
        nxt_row = Range("A1").End(xlUp).Offset(0, 0).Row

         'Below is from a recorded macro importing a text file
        FileNum = FreeFile()
curCol = 1
Open strPath & strExtension For Input As #FileNum
While Not EOF(FileNum)
    Line Input #FileNum, DataLine
    ActiveSheet.Cells(nxt_row, curCol) = DataLine
    curCol = curCol + 1
Wend
Close #FileNum

        strExtension = Dir
    Loop

    Application.ScreenUpdating = True

End Sub

解决方案

I think your issue is with this row:

 nxt_row = Range("A1").End(xlUp).Offset(0, 0).Row

Replace it with this:

 nxt_row = Range("A10000").End(xlUp).Offset(1, 0).Row

Or an alternative:

if Range("A1").Value = "" then 
  nxt_row = 1
else
  if Range("A2").Value = "" then 
    nxt_row = 2
  else
     nxt_row = Range("A1").End(xlDown).Offset(1).Row
  end if
end if

这篇关于使用vba将多个文本文件导入Excel中的新行？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！