Question

我的代码目前打开一个文件选择器，并选择有兴趣组合到我的主工作表中的文件和特定列。

我选择几个.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

Answer 1

由于行数由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

VBA，将多个工作簿中的大数据导入主表

1 个答案: