从另一个应用程序运行 excel 宏时的 Range.copy 问题答案

【问题标题】：Range.copy problem when running excel macro from another application从另一个应用程序运行 excel 宏时的 Range.copy 问题
【发布时间】：2021-11-06 18:57:07
【问题描述】：

我正在尝试从另一个应用程序在 excel 中运行此代码。代码运行没有问题，但是 rngNumber.Copy wsData.Range("A2") 没有被复制。我已经直接在excel中测试了相同的代码，它被完美地复制了。我认为当代码从另一个应用程序运行时，rngNumber 可能没有正确设置。但是，我不明白确切的原因。任何建议将不胜感激，谢谢。

Sub TEST()

' Try to connect to a running instance of Excel.
    Dim excelApp As Excel.Application
    On Error Resume Next
    Set excelApp = GetObject(, "Excel.Application")
    
    If Err Then
        Err.Clear
        
        ' Couldn't connect so start Excel.  It's started invisibly.
        Set excelApp = CreateObject("Excel.Application")
        
        If Err Then
            MsgBox "Cannot access excel."
            Exit Sub
        End If
    End If
    
    ' You can make it visible if you want.  This is especially
    ' helpful when debugging.
    excelApp.Visible = True

    'Open the excel file (through dialog)
    Dim ExcelFilePath As Variant
    ExcelFilePath = excelApp.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*")
    If ExcelFilePath <> False Then
        Set wb = excelApp.Workbooks.Open(ExcelFilePath)
    End If
    
    ' Open the excel file
    Dim wb as Workbook
    Set wb = excelApp.ActiveWorkbook
    Dim ws as Worksheet
    Set ws = wb.Worksheets(1)
    ws.Activate
   
    'Set Worksheet
    Dim wsData As WorkSheet
    Set wsData = wb.Worksheets(2)
    
    'Write column titles
    With wsData
        .Cells(1, "A").Value = "Number"
    End With
           
    'Get column letter for each column whose first row starts with an specific string
     ws.Activate
     Dim sNumber as String
     sNumber= Find_Column("Number") 
        
    'Define variables
    Dim rngNumber As Range
                 
    ' Copy and paste data from "Number" column to Column "A" in Worksheets "Data"
    ws.Activate
    'Find which is the last row with data in "Number" column and set range
    With ws.Columns(sNumber)
        Set rngNumber = Range(.Cells(2), .Cells(.Rows.Count).End(xlUp))
    End With
    'Copy and paste data from "Number" column
    rngNumber.Copy wsData.Range("A2")

End Sub

Private Function Find_Column(Name As String) As String
   
    Dim rngName As Range
    Dim Column As String
    
    With ws.Rows(1)
        On Error Resume Next
        Set rngName = .Find(Name, .Cells(.Cells.Count), xlValues, xlWhole)
        ' Calculate Name Column Letter.
        Find_Column = Split(rngName.Address, "$")(1)
                
    End With
    
End Function

【问题讨论】：

@EEM 这是关于我问你的问题的完整问题。
试试Dim rngNumber As excelApp.Range
@CDP1802 我试过了，但出现编译错误“未定义用户定义的类型”。无论如何，发布的代码只是较长代码的第一部分。在其余代码中，我设置了其他范围，它们工作得很好。只是在列内定义范围时：``` With ws.Columns(sNumber)```
问题是Range(.Cells(2), .Cells(.Rows.Count).End(xlUp))。这只是选择 1 个单元格，我认为您想要一个范围内的多个单元格，如果是这样，它就像.Range(.Cells(1,1), .Cells(1,1000))。您也错过了范围开头的.。
您的代码中存在一些问题... 1. 在不工作的代码中使用On Error Resume Next，而不是On Error GoTo 0，这是一个坏主意。当出现错误时（在以下所有代码中），它不仅不会让 VBA 发出警告。 2 您在Sub 级别将ws 声明为Worksheet，并尝试在Find_Column 函数中使用它。 VBA 不知道它是什么，如果完全无用的On Error Resume Next 不应该存在，它会发出警告。 3. 您应该在模块顶部使用Option explicit 并声明所有使用的变量。

标签： excel vba copy

【解决方案1】：

显式定义excel对象，去掉On Error Resume Next。这适用于 Word。

Option Explicit

Sub TEST()

    ' Try to connect to a running instance of Excel.
    Dim excelApp As Excel.Application
    Dim wb As Excel.Workbook
    Dim ws As Excel.WorkSheet, wsData As Excel.WorkSheet
    Dim rngNumber As Excel.Range
    
    On Error Resume Next
    Set excelApp = GetObject(, "Excel.Application")
    If Err Then
        Err.Clear
            
        ' Couldn't connect so start Excel.  It's started invisibly.
        Set excelApp = CreateObject("Excel.Application")
            
        If Err Then
            MsgBox "Cannot access excel."
            Exit Sub
        End If
    End If
    On Error GoTo 0
    
    ' You can make it visible if you want.  This is especially
    ' helpful when debugging.
    excelApp.Visible = True
    excelApp.WindowState = xlMinimized

    'Open the excel file (through dialog)
    Dim ExcelFilePath As Variant
    ExcelFilePath = excelApp.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*")
    If ExcelFilePath = False Then
         MsgBox "No file not selected"
         Exit Sub
    End If

    Set wb = excelApp.Workbooks.Open(ExcelFilePath)
    Set ws = wb.Sheets(1)
    Set wsData = wb.Sheets(2)
          
    ' Get column letter for each column whose first row
    ' starts with an specific string
    Dim sNumber As String, LastRow As Long
    sNumber = Find_Column(ws, "Number")
    If sNumber = "#N/A" Then
        MsgBox "Column 'Number' not found in " & vbLf & _
                "Wb " & wb.Name & " Sht " & ws.Name, vbExclamation
        Exit Sub
    End If
                
    ' Copy and paste data from "Number" column to Column "A" in Worksheets "Data"
    ' Find which is the last row with data in "Number" column and set range
    With ws
        LastRow = .Cells(.Rows.Count, sNumber).End(xlUp).Row
        Set rngNumber = .Cells(1, sNumber).Resize(LastRow)
    End With
    'Copy and paste data from "Number" column
    rngNumber.Copy wsData.Range("A1")

    excelApp.WindowState = xlMinimized
    MsgBox LastRow & " rows copied from column " & sNumber, vbInformation

End Sub

Private Function Find_Column(ws, Name As String) As String
   
    Dim rngName As Excel.Range
    With ws.Rows(1)
        Set rngName = .Find(Name, After:=.Cells(.Cells.Count), _
                       LookIn:=xlValues, lookat:=xlWhole)
    End With

    If rngName Is Nothing Then
        Find_Column = "#N/A"
    Else   ' Calculate Name Column Letter.
        Find_Column = Split(rngName.Address, "$")(1)
    End If
    
End Function

【讨论】：