我的代码目前打开一个文件选择器,并选择有兴趣组合到我的主工作表中的文件和特定列。
我选择几个.csv文件并引入我选择的列。
问题我有,
1)这些文件很大,400kb。
2)我得到运行时错误1004,复制区域和粘贴区域的大小和形状不一样。我的excel表格上的空间不足了吗?当我调试我在行copyRng.Copy destRng
我的最终目标是查看并计算并查看我所有工作簿中Col C(可能还有其他一些列)的唯一值。
Option Explicit
Dim wsMaster As Workbook, csvFiles As Workbook
Dim Filename As String
Dim File As Integer
Dim r As Long
Public Sub Consolidate()
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Title = "Select files to process"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
Set wsMaster = ActiveWorkbook
Dim copyRng As Range, destRng As Range
Dim firstRow As Long
For File = 1 To .SelectedItems.Count
Filename = .SelectedItems.Item(File)
If Right(Filename, 4) = ".csv" Then
Set csvFiles = Workbooks.Open(Filename, 0, True)
r = wsMaster.Sheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row
'' This is the main new part
Set copyRng = csvFiles.Sheets(1).Range("C1:C" & r)
With wsMaster.Sheets("Sheet1")
firstRow = .Cells(.Rows.Count, 2).End(xlUp).Row
Set destRng = .Range("A" & firstRow + 1).Offset(0, 1)
End With
copyRng.Copy destRng
''''''''''
csvFiles.Close SaveChanges:=False 'close without saving
End If
Next File
End With
Set wsMaster = Nothing
Set csvFiles = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
使用以下建议
更新了代码Option Explicit
Dim wsMaster As Workbook, csvFiles As Workbook
Dim Filename As String
Dim File As Integer
Dim r As Long
Public Sub Consolidate()
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Title = "Select files to process"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
Set wsMaster = ActiveWorkbook
Dim copyRng As Range, destRng As Range
Dim firstRow As Long
For File = 1 To .SelectedItems.Count
Filename = .SelectedItems.Item(File)
If Right(Filename, 4) = ".csv" Then
Set csvFiles = Workbooks.Open(Filename, 0, True)
r = csvFiles.Sheets(1).Range("C" & Rows.Count).End(xlUp).Row
'' This is the main new part
Set copyRng = csvFiles.Sheets(1).Range("C1:C" & r)
With wsMaster.Sheets("Sheet1")
firstRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
Set destRng = .Range("B" & firstRow & "B" & (firstRow + r))
End With
destRng.Value = copyRng.Value
''''''''''
csvFiles.Close SaveChanges:=False 'close without saving
End If
Next File
End With
Set wsMaster = Nothing
Set csvFiles = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
答案 0 :(得分:0)
由于行数由r
定义,您可以设置目标范围的尺寸。下面的更改应该通过消除剪贴板的使用来修复复制粘贴错误并加快代码速度(假设您只想复制值)。
If Right(Filename, 4) = ".csv" Then
Set csvFiles = Workbooks.Open(Filename, 0, True)
r = csvFiles.Sheets(1).Range("C" & Rows.Count).End(xlUp).Row
'' This is the main new part
Set copyRng = csvFiles.Sheets(1).Range("C1:C" & r)
With wsMaster.Sheets("Sheet1")
firstRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
Set destRng = .Range("B" & firstRow & ":B" & (firstrow + r))
End With
DestRng.value = CopyRng.value
''''''''''
csvFiles.Close SaveChanges:=False 'close without saving
End If