【问题标题】:Copy paste from closed workbook using VBA in Excel在 Excel 中使用 VBA 从已关闭的工作簿中复制粘贴
【发布时间】:2016-06-03 11:20:12
【问题描述】:

我有 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

【问题讨论】:

    标签: excel vba excel-4.0


    【解决方案1】:
    ActiveSheet.Cells(Range("C8").Row, Columns.Count).End(xlToLeft).Offset(0, 1) = GetValueFromClosedWorkbook(p, f, s, a)
    

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

    如果您将单元格地址指定为其范围并且它返回零,则该单元格为空,否则它有一个值,然后您可以再次使用 ExecuteExcel4Macro(arg) 方法并将单元格引用作为其参数。在后一种情况下,您可能希望在原始“范围”上使用 .Offset(rowOffset) 方法来转移到与其分开的单元格 rowOffset 行。

    为了不迷失在引用中,我建议你重构你的代码并广泛使用“包装器”,以便拥有干净的可维护代码

    根据我的理解,你可以在这里找到我想出的东西

    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
    

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

    【讨论】:

    • 嗨@user3598756,如何检查D39单元格中的值是否为空,然后想从D38单元格中分配新值? .谢谢
    • 感谢您抽出宝贵时间用出色的解决方案回答我的问题。再次感谢@user3598756
    猜你喜欢
    • 2016-10-25
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多