时间戳

首页 > 解决方案 > 将范围保存在 VBA 中的变量中以用于多个文件

excel - 将范围保存在 VBA 中的变量中以用于多个文件

问题描述

在这个项目中，我需要从多个文件中复制信息并将它们粘贴到主文件中。用户将首先选择他们希望打开的 .CSV 文件。接下来，他们将选择他们希望从每个文件中复制的数据范围。然后程序将从每个文件中获取该信息并将其放入主文件中。

我无法让这个范围对象为我工作。我不能用任何东西选择可变范围。我试过使用：

ActiveWorkbook.ActiveSheet.Range(rng).Copy

filenames(i).ActiveSheet.Range(rng).Copy

我曾尝试使用 rng.address 但这似乎对我也不起作用。

并且可能有其他不同的方式，但没有任何效果。我假设我对范围变量做错了什么，但我不知道出了什么问题。我也尝试在关闭原始工作簿之前放置代码，但这也没有奏效。

我收到运行时错误：'9' 或运行时错误'424'。

Option Explicit
Option Base 1

Sub importData()

Dim awb As Workbook, twb As Workbook
Dim i As Integer, j As Integer
Dim filenames() As Variant, content() As Variant
Dim nc As Integer, nw As Integer, nr As Integer
Dim rng As Range, r As Range
'Application.ScreenUpdating = False
Set twb = ThisWorkbook

'Has the user select workbooks to open
filenames = Application.GetOpenFilename(FileFilter:="Excel filter (*.csv), *csv", Title:="Open File(s):", MultiSelect:=True)
nw = UBound(filenames)

'Has the user select the range that wish to copy into the master file
Workbooks.Open filenames(1)
Set rng = Application.InputBox(Prompt:="Select range: ", Title:="Range Input", Type:=8)
nr = rng.Rows.Count
ActiveWorkbook.Close SaveChanges:=False

ReDim content(nw, nr)

'Opens all the workbooks and copys the selected area
For i = 1 To nw
    Workbooks.Open filenames(i)
    Set awb = ActiveWorkbook
    j = 1
    
    'This following line is causing my all the problems
    filenames(i).ActiveSheet.Range(rng).Copy

Next i
End Sub

标签： excelvba

解决方案

从多个 CSV 文件导入范围

  • 以下将（在用户输入后）将相同范围从每个源工作簿（工作表（CSV意味着每个工作簿一个工作表））复制到包含此代码（）的工作簿的给定（目标）工作表（dName）ThisWorkbook，一个在另一个之下.
  • 调整常量部分中的值。
Option Explicit

Sub importData()
    
    ' Constants
    
    Const dName As String = "Sheet1"
    Const dFirst As String = "A2"
    
    ' Destination
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook
    Dim dCell As Range: Set dCell = dwb.Worksheets(dName).Range(dFirst)
    
    ' Source
    
    'Have the user select the workbooks to open
    Dim FileNames As Variant: FileNames = Application.GetOpenFilename( _
        FileFilter:="Excel filter (*.csv),*csv", Title:="Open File(s):", _
        MultiSelect:=True)
    
    'Validate file names
    If VarType(FileNames) = vbBoolean Then
        MsgBox "You canceled.", vbExclamation, "File Selection"
        Exit Sub
    End If
    
    Dim fCount As Long: fCount = UBound(FileNames)
    
    'Have the user select the range that is to be copied into the master file
    Dim sws As Worksheet: Set sws = Workbooks.Open(FileNames(1)).Worksheets(1)
    On Error Resume Next
    Dim rng As Range: Set rng = Application.InputBox( _
        Prompt:="Select range: ", Title:="Range Input", Type:=8)
    On Error GoTo 0
    
    Application.ScreenUpdating = False
    
    'Validate range
    If rng Is Nothing Then
        Application.DisplayAlerts = False
        sws.Parent.Close False
        Application.DisplayAlerts = True
        MsgBox "You canceled.", vbCritical, "Range Selection"
        Exit Sub
    End If
    
    Dim rAddress As String: rAddress = rng.Address
    Dim rCount As Long: rCount = rng.Rows.Count
    
    ' Copy
    
    'Open all the workbooks and copy the selected range
    Dim n As Long
    For n = 1 To fCount
        Set sws = Workbooks.Open(FileNames(n)).Worksheets(1)
        sws.Range(rAddress).Copy dCell
        Application.DisplayAlerts = False
        sws.Parent.Close False
        Application.DisplayAlerts = True
        Set dCell = dCell.Offset(rCount)
    Next n

    Application.ScreenUpdating = True

    'Inform user
    MsgBox "Data imported.", vbInformation, "Success"

End Sub

推荐阅读