在 Excel 中使用 VBA 从已关闭的工作簿中复制粘贴

Question

我有 2 个工作簿：“reportPageImpression.xlsx”和“testCloseWorkbook.xslx”。目前，我可以在单击“更新”按钮时从 reportPageImpression 获取数据到 testCloseWorkbook。

我尝试做的是再次单击“更新”按钮时，该值将转到“Jan-16”（新列）等。这是我的代码：

Option Explicit
Private Function GetValueFromClosedWorkbook(path, file, sheet, ref)
    Dim arg As String
    
    'Let’s check whether the file exists
    If Right(path, 1) <> "\" Then path = path & "\"
    If Dir(path & file) = "" Then
        GetValueFromClosedWorkbook = "File Not Found"
        Exit Function
    End If
    
    'We create the argument
    arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
          Range(ref).Range("A1").Address(, , xlR1C1)
    
    'MsgBox arg
    'Now we execute an XLM macro
    'All references must be given as R1C1 strings.
    GetValueFromClosedWorkbook = ExecuteExcel4Macro(arg)

End Function

Sub TestGetValueFromClosedWorkbook()
    Dim p As String, f As String
    Dim s As String, a As String
    
    p = ThisWorkbook.path
    f = "reportPageImpression.xlsx"
    s = "report_page_impression"
    a = "D39"
         
    ActiveSheet.Range("C8") = GetValueFromClosedWorkbook(p, f, s, a)
     
End Sub

Answer 1

ActiveSheet.Cells(Range("C8").Row, Columns.Count).End(xlToLeft).Offset(0, 1) = GetValueFromClosedWorkbook(p, f, s, a)

要检查单元格是否为空，您必须使用类似“COUNTA(range)”的公式作为 ExecuteExcel4Macro(arg) 方法的参数，并返回已关闭工作簿中非空单元格的数量指定范围。

如果您将单元格地址指定为其范围并且它 returns 为零，那么该单元格为空，否则它有一个值，然后您可以再次使用 ExecuteExcel4Macro(arg) 方法，并将单元格引用作为其争论。在后一种情况下，您可能希望在原始 "Range" 上使用 .Offset(rowOffset) 方法来转移到与其相距 rowOffset 行的单元格。

为了不迷失在参考文献中，我建议您重构您的代码并广泛使用 "wrappers" 以清理可维护的代码

在这里你可以找到我的理解

Sub TestGetValueFromClosedWorkbook()
Dim p As String, f As String
Dim s As String, a As String
Dim argPart As String

Dim var As Variant
Dim checkSheetResult As String

p = ThisWorkbook.path
f = "reportPageImpression.xlsx"
s = "report_page_impression"
a = "D39"

checkSheetResult = CheckSht(p, f) ' check if the file to be read as closed is not already opened and if it exists
If checkSheetResult = "" Then

    argPart = "'" & p & "[" & f & "]" & s & "'!" 'set the "constant" part of the argument

    var = GetFirstNonEmptyValueFromClosedWorkbook(a, argPart, -1)

    If var = -1 Then
        MsgBox ("No value found!")
    Else
        ActiveSheet.Cells(Range("C8").row, Columns.Count).End(xlToLeft).Offset(0, 1) = var
    End If

Else
    MsgBox checkSheetResult
End If

End Sub


Private Function GetFirstNonEmptyValueFromClosedWorkbook(ref As String, argPart As String, Optional rowOffsetRate As Variant) As Variant

Dim arg As String, funcArg As String
Dim var As Variant
Dim rowOffset As Long

If IsMissing(rowOffsetRate) Then rowOffsetRate = 0

rowOffset = 0

funcArg = SetArgFunction(ref, argPart, rowOffset, arg)
var = ExecuteExcel4Macro(funcArg)
Do While var = -1 And CheckIfOffset(ref, CLng(rowOffsetRate), rowOffset)
    funcArg = SetArgFunction(ref, argPart, rowOffset, arg)
    var = ExecuteExcel4Macro(funcArg)
Loop

If var <> -1 Then var = ExecuteExcel4Macro(arg)

GetFirstNonEmptyValueFromClosedWorkbook = var

End Function

Private Function SetArgFunction(ref As String, argPart As String, rowOffset As Long, arg As String) As String

arg = argPart & Range(ref).Range("A1").Offset(rowOffset).Address(, , xlR1C1)
SetArgFunction = "IF(COUNTA(" & arg & ")>0,1,-1)"

End Function


Private Function CheckIfOffset(ref As String, rowOffsetRate As Long, rowOffset As Long) As Boolean
Dim nextRow As Long
Dim cell As Range

Set cell = Range(ref)

nextRow = cell.Offset(rowOffset).row + rowOffsetRate

CheckIfOffset = rowOffsetRate > 0 And nextRow <= cell.Parent.Cells(cell.Parent.Rows.Count, 1).row _
                Or (rowOffsetRate < 0 And nextRow > 0)

If CheckIfOffset Then rowOffset = rowOffset + rowOffsetRate

End Function


Private Function CheckSht(path As String, file As String) As String
Dim wb As Workbook
Dim okSheet As Boolean

If Right(path, 1) <> "\" Then path = path & "\"

On Error Resume Next
Set wb = Workbooks(file)
On Error GoTo 0

okSheet = wb Is Nothing
If Not okSheet Then okSheet = wb.path & "\" <> path

If Not okSheet Then
    ' file is already open
    CheckSht = "workbook:" & vbCrLf & vbCrLf & file & vbCrLf & vbCrLf & "in:" & vbCrLf & vbCrLf & path & vbCrLf & vbCrLf & "is already open!"
Else
    'Let’s check whether the file exists
    If Dir(path & file) = "" Then CheckSht = "workbook:" & vbCrLf & vbCrLf & file & vbCrLf & vbCrLf & "in:" & vbCrLf & vbCrLf & path & vbCrLf & vbCrLf & "not found!"
End If

End Function

转移到不同单元格的 "logic" 全部在 var = GetFirstNonEmptyValueFromClosedWorkbook(a, argPart, -1) 中，其中 -1 是 GetFirstNonEmptyValueFromClosedWorkbook(ref As String, argPart As String, Optional rowOffsetRate As Variant) As Variant 函数考虑的 "rowOffsetRate" 如果地址 a 中的单元格为空。如果没有传递 "rowOffsetRate" 则它只检查地址 a

中的单元格

在 Excel 中使用 VBA 从已关闭的工作簿中复制粘贴

Copy paste from closed workbook using VBA in Excel

excel

vba

excel-4.0