我有一个包含多个CSV文件的文件夹,我有另一个包含Excel工作簿的文件夹。我想通过单击按钮将工作簿中的所有CSV文件导入单独的工作表(fx 3.csv将具有工作表名称" 3"等等)。这些CSV文件经常更新,但并不总是在同一天更新。我希望导入代码也更新任何已更新的CSV文件。我假设每次导入所有文件时都会隐式执行此操作。
以下代码可以解决这个问题。问题是每当我点击按钮时它都不会覆盖现有的纸张。它增加了新的床单。我们说我上传(这是第一次)。工作簿中的工作表称为city1.csv,city2.csv等。第二次运行代码时,它添加了另一个工作表范围city1,city2等。第三次是city1(1),city2(2)等
每次单击按钮而不是添加新工作表时,如何使导入代码覆盖?
THX!
Sub import_test3()
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook
MyPath = "\\filepath\folder"
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If
FilesInPath = Dir(MyPath & "*.csv")
If FilesInPath = "" Then
MsgBox "No CSV files found"
Exit Sub
End If
On Error GoTo CleanUp
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
mybook.Worksheets(1).Copy after:= _
basebook.Sheets(basebook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = mybook.Name
On Error GoTo 0
mybook.Close savechanges:=False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = True
End Sub
答案 0 :(得分:1)
您可能需要考虑Power Query而不是VBA。 Power Query可以从Microsoft免费下载Excel 2010和2013。
从文件创建查询,指向CSV文件并将其加载到工作表。
为每个CSV文件/工作表冲洗并重复。
设置要在打开文件时刷新的数据连接。
如果它们具有相同的结构,也可以将所有CSV文件合并为一个工作表。您甚至不需要知道CSV文件的名称。您可以加载特定文件夹中的所有CSV文件,并使用Power Query将它们合并到一个工作表中。 Mike Girvin(ExcelIsFun)有关于here的精彩视频。
答案 1 :(得分:1)
这个解决方案有2个部分:找出是否有纸张并覆盖它;并查明文件是否已更改。
你的第一点问题是,你真的没有任何东西来质疑这张表是否存在。您可以找到工作表使用的名称:
Dim sheetName as String
sheetName = Left(MyFiles(Fnum), InStr(MyFiles(Fnum), ".") - 1)
然后,您可以遍历所有工作表以查看是否已存在:
Dim sheetExists As Boolean
Dim ws As Worksheet
Dim sheetCounter As Integer
sheetExists = False
sheetCounter = 0
For Each ws In basebook.Worksheets
sheetCounter = sheetCounter + 1
If ws.Name = sheetName Then
sheetExists = True
End If
Next ws
注意sheetCounter
变量。这样我们就可以跟踪现有工作表的位置,以便我们可以将新版本推送到Sheets
中的相同位置。
接下来,我们可以打开新工作簿并将其分配给mybook
参考。如果工作表已经存在,我们应该将其删除,如果它不存在,我们希望将新工作表放在Sheets
集合的后面。
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
If sheetExists Then
basebook.Sheets(sheetName).Delete
Else
sheetCounter = basebook.Sheets.Count
End If
mybook.Worksheets(1).Copy after:= basebook.Sheets(sheetCounter)
然后我们继续将工作表复制到现有工作簿中,重命名新工作表并关闭而不保存:
basebook.Sheets(sheetCounter).Name = mybook.Name
mybook.Close savechanges:=False
如果自上次修改工作簿以来.csv
文件已被修改,则只会发生上述所有情况。要弄清楚使用字符串作为文件路径是有点棘手,但如果使用FileSystemObject
s则更直接。
FileSystemObject
的行为类似于windows文件夹层次结构并提供{{1具有文件系统属性的{}和File
个对象。以,例如下面的代码:
Folder
此代码确定上次保存工作簿的时间,根据.csv文件的路径创建Dim fso As New FileSystemObject
Dim fld As Folder
Dim f As File
Dim path As String
path = "C:\Test\"
Dim lastModified As Date
lastModified = FileDateTime(ThisWorkbook.path)
Set fld = fso.GetFolder(path)
For Each f In fld.Files
If f.Type = "CSV File" Then
If f.DateLastModified - lastModified > 0 Then
'We have a .csv file that was modified after this
'workbook was saved so we should copy it into here
End If
End If
Next f
对象,然后依次遍历每个文件。如果发现文件的类型为Folder
,并且自上次保存工作簿以来该文件已被修改,则会对其感兴趣。
实质上,整个例程可以组合成以下代码:
CSV File