博客
关于我
使用VBA合并多个TXT文件内容到Excel的不同列的实现
阅读量:160 次
发布时间:2019-02-27

本文共 2530 字,大约阅读时间需要 8 分钟。

目录

需求

某一文件夹下有多个txt文件,文件里每行是一个内容,类似:

data1.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/

你可能感兴趣的文章
mysql5.7 for windows_MySQL 5.7 for Windows 解压缩版配置安装
查看>>
Webpack 基本环境搭建
查看>>
mysql5.7 安装版 表不能输入汉字解决方案
查看>>
MySQL5.7.18主从复制搭建(一主一从)
查看>>
MySQL5.7.19-win64安装启动
查看>>
mysql5.7.19安装图解_mysql5.7.19 winx64解压缩版安装配置教程
查看>>
MySQL5.7.37windows解压版的安装使用
查看>>
mysql5.7免费下载地址
查看>>
mysql5.7命令总结
查看>>
mysql5.7安装
查看>>
mysql5.7性能调优my.ini
查看>>
MySQL5.7新增Performance Schema表
查看>>
Mysql5.7深入学习 1.MySQL 5.7 中的新增功能
查看>>
Webpack 之 basic chunk graph
查看>>
Mysql5.7版本单机版my.cnf配置文件
查看>>
mysql5.7的安装和Navicat的安装
查看>>
mysql5.7示例数据库_Linux MySQL5.7多实例数据库配置
查看>>
Mysql8 数据库安装及主从配置 | Spring Cloud 2
查看>>
mysql8 配置文件配置group 问题 sql语句group不能使用报错解决 mysql8.X版本的my.cnf配置文件 my.cnf文件 能够使用的my.cnf配置文件
查看>>
MySQL8.0.29启动报错Different lower_case_table_names settings for server (‘0‘) and data dictionary (‘1‘)
查看>>