我刚好做过类似的批量数据导入需求，结合你的场景，写了一套完整的VB脚本，覆盖你提到的所有核心要求：统一表头合并数据、支持每周增量更新、添加周标签、清理空行。

核心实现思路 #

• 只保留第一个导入文件的表头，后续所有文件直接追加数据行，确保表头统一
• 新增周标签列，你可以手动指定或者从文件名自动提取（代码里留了两种方式）
• 导入前检查汇总表已有的周标签，避免重复导入同一周的文件
• 导入完成后自动清理整张工作表的空行

完整VB脚本代码 #

Option Explicit

' 配置参数，根据你的实际情况修改
Const FOLDER_PATH = "C:\Your\Text\Files\Folder" ' 存放文本文件的文件夹路径
Const EXCEL_FILE_PATH = "C:\Your\Summary\File.xlsx" ' 汇总Excel文件路径
Const WEEK_TAG = "1810" ' 手动指定本周标签，或者注释掉用下面的文件名提取逻辑
Const TEXT_DELIMITER = vbTab ' 文本文件分隔符，制表符用vbTab，逗号用","

Dim objExcel, objWorkbook, objWorksheet
Dim objFSO, objFolder, objFile
Dim lastRow, i, startRow, hasHeader, existingTags
Dim fileWeekTag ' 从文件名提取的周标签

' 创建Excel对象
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False ' 后台运行，不显示Excel界面
objExcel.DisplayAlerts = False ' 禁用提示框

' 打开或创建汇总工作簿
On Error Resume Next
Set objWorkbook = objExcel.Workbooks.Open(EXCEL_FILE_PATH)
If Err.Number <> 0 Then
    ' 如果文件不存在，新建工作簿并添加表头（这里假设文本文件表头是固定的，你可以修改）
    Set objWorkbook = objExcel.Workbooks.Add()
    Set objWorksheet = objWorkbook.Worksheets(1)
    objWorksheet.Name = "汇总数据"
    ' 手动写入表头，或者从第一个文件读取，这里示例手动写
    objWorksheet.Range("A1").Value = "列1"
    objWorksheet.Range("B1").Value = "列2"
    objWorksheet.Range("C1").Value = "列3"
    objWorksheet.Range("D1").Value = "周标签" ' 新增的周标签列
    lastRow = 1
Else
    Set objWorksheet = objWorkbook.Worksheets("汇总数据")
    lastRow = objWorksheet.Cells(objWorksheet.Rows.Count, "A").End(-4162).Row ' -4162对应xlUp
    ' 收集已存在的周标签，避免重复导入
    Set existingTags = CreateObject("Scripting.Dictionary")
    For i = 2 To lastRow
        existingTags(objWorksheet.Cells(i, "D").Value) = True
    Next
End If
On Error GoTo 0

' 创建文件系统对象
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(FOLDER_PATH)

hasHeader = True ' 标记是否需要保留表头（仅第一个文件保留）

' 遍历文件夹中的所有文本文件
For Each objFile In objFolder.Files
    If LCase(objFSO.GetExtensionName(objFile.Name)) = "txt" Then
        ' --------------------------
        ' 可选：从文件名提取周标签，比如文件名格式为"data_1810.txt"
        ' fileWeekTag = Mid(objFile.Name, InStr(objFile.Name, "_") + 1, 4)
        ' 替换上面的WEEK_TAG为fileWeekTag即可
        ' --------------------------
        
        ' 检查当前周标签是否已存在，避免重复导入
        If existingTags.Exists(WEEK_TAG) Then
            WScript.Echo "周标签" & WEEK_TAG & "的数据已存在，跳过文件：" & objFile.Name
            Continue For
        End If
        
        ' 导入文本文件到Excel
        objWorksheet.QueryTables.Add _
            Connection:="TEXT;" & objFile.Path, _
            Destination:=objWorksheet.Cells(lastRow + 1, "A")
            
        With objWorksheet.QueryTables(1)
            .TextFileParseType = 1 ' 分隔符类型
            .TextFileTextQualifier = 1 ' 文本限定符
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = (TEXT_DELIMITER = vbTab)
            .TextFileCommaDelimiter = (TEXT_DELIMITER = ",")
            .TextFileSpaceDelimiter = False
            .Refresh BackgroundQuery:=False
            
            ' 如果不是第一个文件，删除导入的表头行
            If Not hasHeader Then
                objWorksheet.Rows(lastRow + 1).Delete
                lastRow = lastRow - 1 ' 回退一行
            End If
            hasHeader = False ' 后续文件不再保留表头
        End With
        
        ' 删除QueryTable对象，避免残留
        objWorksheet.QueryTables(1).Delete
        
        ' 获取当前导入数据的最后一行
        lastRow = objWorksheet.Cells(objWorksheet.Rows.Count, "A").End(-4162).Row
        
        ' 填充周标签列
        objWorksheet.Range("D" & (lastRow - (objWorksheet.Cells(lastRow, "A").CurrentRegion.Rows.Count - 1)) & ":D" & lastRow).Value = WEEK_TAG
    End If
Next

' 清理空行
lastRow = objWorksheet.Cells(objWorksheet.Rows.Count, "A").End(-4162).Row
For i = lastRow To 2 Step -1
    If objWorksheet.Cells(i, "A").Value = "" And objWorksheet.Cells(i, "B").Value = "" And objWorksheet.Cells(i, "C").Value = "" Then
        objWorksheet.Rows(i).Delete
    End If
Next

' 保存并关闭工作簿
objWorkbook.SaveAs EXCEL_FILE_PATH
objWorkbook.Close
objExcel.Quit

' 释放对象资源
Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing
Set objFile = Nothing
Set objFolder = Nothing
Set objFSO = Nothing
Set existingTags = Nothing

WScript.Echo "数据导入完成！"

关键部分说明 #

1. 周标签设置：

   • 你可以直接在代码开头的WEEK_TAG常量里手动指定本周的标签（比如"1810"）
   • 如果文件名里包含周标签（比如data_1810.txt），可以注释掉手动指定的代码，启用从文件名提取的逻辑

2. 重复导入防护：

   • 脚本会自动读取汇总表中已有的周标签，跳过已经导入过的同周文件，适合每周运行增量更新

3. 表头一致性：

   • 脚本只保留第一个导入文件的表头，后续文件直接追加数据行。如果你的文本文件表头有变动，建议在导入前统一所有文件的表头格式，或者在代码里添加表头校验逻辑

4. 空行清理：

   • 脚本会从下往上遍历所有行，删除完全为空的行（你可以根据需要调整判断条件，比如只要A列为空就删除）

使用注意事项 #

• 运行脚本前，请确保目标Excel文件处于关闭状态，避免权限冲突
• 根据你的文本文件分隔符，修改TEXT_DELIMITER常量（制表符用vbTab，逗号用","）
• 如果是第一次运行，脚本会自动创建汇总Excel文件并写入表头，你需要根据实际文本文件的表头修改代码里的表头内容
• 可以把脚本保存为.vbs文件，双击即可运行，无需打开Excel

内容的提问来源于stack exchange，提问作者vivekkr0611