Excel VBA 编程实现一个文件夹下多个多个工作表合并到一个新的工作表中

刘淼淼

Sub Main     Dim SurferApp As Object   '定义Surfer软件启动对象   
Dim BaseName,basename1,inputFile,outputFile As String   
Dim Wks As Object   
Dim WksRange1 As Object     
Set SurferApp = CreateObject("Surfer.Application")    '启动Surfer     
SurferApp.Visible = True   '因为仅仅是计算，不显示，效率高点。设置窗口不可见   
'SurferApp.WindowState = srfWindowStateMaximized 'surfer最大化     
path="C:\Users\Administrator\Desktop\2023.4.6自动化编程试验\2023.4.6切片slice自动化试验数据\"   '设置工作目录    SurferApp.ScreenUpdating=True '设置图形窗口是否刷新，至此已完成surfer的初始设置。
Dim excelApp As Object
Set excelApp = CreateObject("Excel.Application")
excelApp.Visible = True   '因为仅仅是计算，不显示，效率高点。设置窗口不可见
excelApp.WindowState = srfWindowStateMaximized 'surfer最大化
excelApp.ScreenUpdating = TrueDim xlBook As Object
Set xlBook = excelApp.Workbooks.Add
excelApp.ScreenUpdating = False




Dim DataArr As Object, DataWb As Object, DataSht As Object
Dim EndRow As Long, ToSht As Object, ToRng As ObjectDim FileName2 As String '要合并的工作簿名称
Dim a As Long, b As Long
Set ToSht = xlBook.Worksheets(1)ToSht.Rows("2:1048576").Clear '清除原有数据
FileName2 = Dir(path& "\*.csv")
Do While FileName2 <> ""
excelApp.Workbooks.Open FileName:= FileName2
Set DataWb = xlBook
Set DataSht = DataWb.Worksheets(1)
EndRow = DataSht.Range("A1048576").End(xlUp).Row '提示错误1004
DataArr = DataSht.Range("A2").Resize(EndRow - 1, 8).Value
Set ToRng = ToSht.Range("A1048576").End(xlUp).Offset(1, 0)
For a = 1 To UBound(DataArr, 1) '将数组中超过15位的数字转为文本
For b = 1 To UBound(DataArr, 2)
If Len(DataArr(a, b)) > 15 Then
DataArr(a, b) = "'" & DataArr(a, b)
End If
Next b
Next a
ToRng.Resize(UBound(DataArr, 1), 8).Value = DataArr
DataWb.Close savechanges:=False
FileName2 = Dir
Loop
'Application.ScreenUpdating = TrueMsgBox "合并完成！"
'SurferApp.Quit() '退出Surfer应用程序
End Sub
代码如上我是在surfer scripter中编 辑的上述代码，首先利用surfer 处理，接着利用ExcelVBA 进行合并表格，首先新建一个xlbook，利用它，实现一个文件夹下的多个.csv文件合并到一个Excel表中。EndRow = DataSht.Range("A1048576").End(xlUp).Row '提示错误1004是什么原因了，请教各位大侠，还是这个合并的代码本身就有问题了

liulang0808

https://club.excelhome.net/threa ... tml?_dsign=c5f4544f
资料可以参考

selen

以下是几种可能导致 1004 错误的情况：
对不存在的工作表进行操作
尝试读取或写入不存在的单元格
在保护的工作表上进行不被允许的操作
对包含无效数据的单元格进行操作

目测一下，你的数组定义有问题，数组改成：Dim DataArr() As Variant
看看csv文件中是否有内容
还有为了兼容性，这句Range("A1048576") 最好改成cells(rows.count,"A")

仙女配凡人

excelApp.Workbooks.Open FileName:= FileName2
Set DataWb = xlBook
把这两行代码改成一句试试
Set DataWb = excelApp.Workbooks.Open(FileName2)

刘淼淼

selen 发表于 2023-4-12 19:46
以下是几种可能导致 1004 错误的情况：
对不存在的工作表进行操作
尝试读取或写入不存在的单元格

   数组定义已修改，CSV文件中有内容，兼容性那句改了，还有1004错误。
Dim DataWb As object, Dim DataSht As  object,其实我是想将 DataWb 定义为workbook，Data Sht定义成worksheet，但是 dim as 时找不到对应的类型，应该是在surfer脚本编程中没有对应的类型。
   其实我要实现的功能就是：在surfer scripter脚本中新建一 个Excel工作簿，然后利用它 将文件夹下的csv格式文件合并到这个工作簿的第一个sheet里面。

ykcbf1100

刘淼淼 发表于 2023-4-13 09:19
数组定义已修改，CSV文件中有内容，兼容性那句改了，还有1004错误。
Dim DataWb As object, Dim Data ...

你如果上个附件，问题估计早就解决了。

opiona

参考: https://club.excelhome.net/thread-1409141-1-1.html

工作簿汇总，工作表汇总合并，多文件汇总合并 通用代码 支持多层子文件夹