本文共 2530 字,大约阅读时间需要 8 分钟。
某一文件夹下有多个txt
文件,文件里每行是一个内容,类似:
12345
data2.txt
abcde
最终需要把这些txt
内容复制到excel
里,并存在同一个sheet
的不同列里
Sub AddWorkbook() 'sub表示一个过程 '声明一个变量 Dim isSheetOk As Boolean '调用一个叫做copyTXT2Sheet的函数 isSheetOk = copyTXT2Sheet() If Not isSheetOk Then Exit Sub End If ' 保存结果 saveResult End SubFunction copyTXT2Sheet() As Boolean '函数返回一个布尔值,函数返回值即 函数名=xxx 则表示返回了 xxx Dim resultName As String Dim xFile As String Dim xFileDialog As FileDialog Dim xToBook As Workbook Dim xWb As Workbook Dim xFiles As New Collection '文件选择弹窗 Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker) xFileDialog.AllowMultiSelect = False xFileDialog.Title = "选择包含txt的文件夹" If xFileDialog.Show = -1 Then xStrPath = xFileDialog.SelectedItems(1) End If If xStrPath = "" Then copyTXT2Sheet = False Exit Function End If If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\" End If '获取文件夹下的*.txt文件 xFile = Dir(xStrPath & "*.txt") If xFile = "" Then MsgBox "No files found", vbInformation, "Kutools for Excel" copyTXT2Sheet = False Exit Function End If Do While xFile <> "" xFiles.Add xFile '读取到的文件路径存入集合 xFile = Dir() ' 使用Dir不断访问下个文件,直到没文件 Loop ' 新建一个excel文件 Set xToBook = Workbooks.Add If xFiles.Count > 0 Then For i = 1 To xFiles.Count '读取txt转换成excel,使用utf编码打开(解决中文乱码问题) Workbooks.OpenText Filename:=xStrPath & xFiles.Item(i), Origin:=65001 '复制读取的第一列依次到新建excel的列 Worksheets(1).Range("A:A").Copy xToBook.Sheets(xToBook.Sheets.Count).Columns(i) '设置列宽随内容自适应 xToBook.Sheets(xToBook.Sheets.Count).Columns(i).EntireColumn.AutoFit ' 关闭打开的txt转excel文件,false表示no save change Workbooks(xFiles(i)).Close False Next End If 'resultName = getCurrentTime() & "_合并结果" 'xToBook.SaveAs (resultName) copyTXT2Sheet = True End FunctionFunction saveResult() With Application.FileDialog(msoFileDialogSaveAs) .Title = "选择路径保存结果" .ButtonName = "保存" .InitialFileName = getCurrentTime() & "_合并结果" If .Show = 0 Then MsgBox "文件未保存", vbCritical Exit Function End If Application.DisplayAlerts = False .Execute Application.DisplayAlerts = True End With End FunctionFunction getCurrentTime() getCurrentTime = Format(Now(), "YYYY-mm-dd-HH_MM_SS")End Function
转载地址:http://flbd.baihongyu.com/