1

[找到答案 - 问题不在于 Sourcerange。显然这是因为我没有在 Extractdata1 中为每个 inputWB 指明“.xlsx”。不知何故，这导致代码为每个输出单元格生成相同的值。在为每个 inputWB 添加 .xlsx 后，我能够得到不同的值。]

我在这里有一个代码，我正在尝试使用 ByVal。为了我的目的（复制粘贴数据），我找不到很多资源来学习 ByVal 写作，所以我很努力。

目的：从3个不同输入WB的单元格H17中提取数据，分别粘贴到输出WB的A1、A2、A3中。

问题：下面的代码目前在 A1、A2 和 A3 中给出了相同的值...并且该值等于最后打开的输入 WB（而不是来自 3 个不同输入 WB 的 3 个值）。

我也试过 ByRef 但它没有解决问题。

先感谢您。

Sub Extractdata()
    Dim FromPath As String
    Dim FromSheetName As String
    Dim TargetRange As Range

    With Workbooks.Open("C:\Users\[OutputWB].xlsm").Worksheets("Sheet1")
        Extractdata1 "C:\Users\[InputWB1]", "[InputSheet]", .Range("A1")
        Extractdata1 "C:\Users\[InputWB2]", "[InputSheet]", .Range("A2")
        Extractdata1 "C:\Users\[InputWB3]", "[InputSheet]", .Range("A3")
    End With
End Sub


Sub Extractdata1(ByVal FromPath As String, ByVal FromSheetName As String, ByVal TargetRange As Range)
    With Workbooks.Open(FromPath)
        With .Worksheets(FromSheetName)
            Set SourceRange = .Range("H17")
            TargetRange.Value = SourceRange.Value    
        End With    
    End With
End Sub
4

2 回答 2

1

从不同的文件复制相同的单元格

  • 这对我有用。也许您可以发现相关的差异。
  • ScreenUpdating与它无关，并且在未关闭源文件时也有效。
Option Explicit

Sub Extractdata()

    Const FolderPath As String = "C:\Test\"
    
    Application.ScreenUpdating = False
    
    With Workbooks.Open(FolderPath & "Output.xlsm").Worksheets("Sheet1")
        Extractdata1 FolderPath & "Test1.xlsx", "Sheet1", .Range("A1")
        Extractdata1 FolderPath & "Test2.xlsx", "Sheet1", .Range("A2")
        Extractdata1 FolderPath & "Test3.xlsx", "Sheet1", .Range("A3")
        '.Close SaveChanges:=True
    End With
    
    Application.ScreenUpdating = True

End Sub

Sub Extractdata1( _
        ByVal FromPath As String, _
        ByVal FromSheetName As String, _
        ByVal TargetRange As Range)
    
    With Workbooks.Open(FromPath)
        With .Worksheets(FromSheetName)
            TargetRange.Value = .Range("H17").Value
        End With
        .Close SaveChanges:=False
    End With

End Sub
于 2022-02-16T09:47:07.870 回答
0

如果您想要做的是将一个单元格的值链接到另一个工作簿中的值，则有一种更简单的方法：将以下公式粘贴到 OutputWB.xlsm 的单元格 A1、A2 和 A3 中，工作将完成没有代码。

='C:\Users\[InputWB1.xlsx]Sheet1'!$H$17
='C:\Users\[InputWB2.xlsx]Sheet1'!$H$17
='C:\Users\[InputWB3.xlsx]Sheet1'!$H$17

如果这不能满足您的需要，请参阅以下修改后的代码。我删除了导致文件未找到错误的方括号。我还将文件路径放入一个变量中，以便在不同的环境中进行测试。我强烈建议在最后添加关闭文件指令，除非您想在最后保持所有工作簿打开。

Sub Extractdata()

Dim FromPath As String
Dim FromSheetName As String
Dim TargetRange As Range
Dim FilePath As String
FilePath = "C:\Users\"

With Workbooks.Open(FilePath & "OutputWB.xlsm").Worksheets("Sheet1")

Extractdata1 FilePath & "InputWB1", "InputSheet", .Range("A1")
Extractdata1 FilePath & "InputWB2", "InputSheet", .Range("A2")
Extractdata1 FilePath & "InputWB3", "InputSheet", .Range("A3")

End With

End Sub


Sub Extractdata1(ByVal FromPath As String, ByVal FromSheetName As String, ByVal TargetRange As Range)
    With Workbooks.Open(FromPath)
        With .Worksheets(FromSheetName)
Debug.Print (FromPath)
Set SourceRange = .Range("H17")
TargetRange.Value = SourceRange.Value
    
        End With
    
    End With
End Sub
于 2022-02-16T06:04:12.760 回答