Question

我编写了一个代码，该代码正在打开一个窗口，可以在其中选择要从中复制并导入工作表的excel工作簿（＃2）。然后，代码检查正在打开的工作簿（＃2）中是否存在所需的工作表（名为“指导”）。如果是，则应将其复制并粘贴到当前工作簿中（＃1）。粘贴工作表后，应再次关闭工作簿（＃2）。

到目前为止，代码已完成我想要的工作，因为它打开了窗口，并让我选择了所需的工作表（名为“指导”），但我遇到了错误（不确定翻译是否正确）

“运行时错误'9'：索引超出范围”

应该在其中复制和粘贴工作表的地方。

在此方面的任何帮助将不胜感激！预先感谢。

 Private Function SheetExists(sWSName As String, Optional InWorkbook As Workbook) As Boolean

 If InWorkbook Is Nothing Then
    Set InWorkbook = ThisWorkbook
 End If

 Dim ws As Worksheet
 On Error Resume Next
 Set ws = Worksheets(sWSName)
 If Not ws Is Nothing Then SheetExists = True

 On Error GoTo 0

 End Function


 Sub GuidanceImportieren()


 Dim sImportFile As String, sFile As String
 Dim sThisWB As Workbook
 Dim vFilename As Variant

 Application.ScreenUpdating = False
 Application.DisplayAlerts = False

 Set sThisWB = ActiveWorkbook
 sImportFile = Application.GetOpenFilename("Microsoft Excel Workbooks, 
 *xls; *xlsx; *xlsm")

 If sImportFile = "False" Then
 MsgBox ("No File Selected")
 Exit Sub

 Else
 vFilename = Split(sImportFile, "|")
 sFile = vFilename(UBound(vFilename))
 Application.Workbooks.Open (sImportFile)

 Set wbWB = Workbooks("sImportFile")
 With wbWB
 If SheetExists("Guidance") Then
 Set wsSht = .Sheets("Guidance")
 wsSht.Copy Before:=sThisWB.Sheets("Guidance")
 Else
 MsgBox ("No worksheet named Guidance")
 End If

 wbWB.Close SaveChanges:=False
 End With
 End If

 Application.ScreenUpdating = True
 Application.DisplayAlerts = True

 End Sub

Answer 1

问题在这里

SheetExists("Guidance")

还请注意，Private Function SheetExists(WorksheetName As String, Optional InWorkbook As Workbook) As Boolean If InWorkbook Is Nothing Then Set InWorkbook = ThisWorkbook 'fallback if not set End If Dim ws As Worksheet On Error Resume Next Set ws = InWorkbook.Worksheets(WorksheetName) SheetExists = Not ws Is Nothing On Error Goto 0 'necessary because the Err.Number will not be cleared on End Function End Function不会签入特定的工作簿（这可能会失败）。我建议将功能扩展到：

SheetExists("Guidance", sThisWB)
SheetExists("Guidance", wbWB)

因此，您可以测试工作表是否存在于诸如

的特定工作簿中

Sub GuidanceImportieren()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim sImportFile As String
    sImportFile = Application.GetOpenFilename("Microsoft Excel Workbooks, *xls; *xlsx; *xlsm")

    If sImportFile = False Then 'false should not be "false"
        MsgBox "No File Selected"
        Exit Sub
    Else
        Dim vFilename As Variant
        vFilename = Split(sImportFile, "|")

        Dim sFile As String
        sFile = vFilename(UBound(vFilename))

        Dim ImportWorkbook As Workbook
        Set ImportWorkbook = Application.Workbooks.Open(sImportFile)

        If SheetExists("Guidance", ImportWorkbook) Then
            ImportWorkbook.Sheets("Guidance").Copy Before:=ThisWorkbook.Sheets("Guidance")
            'you might need to change it into something like this:
        Else
            MsgBox "No worksheet named Guidance"
        End If

        ImportWorkbook.Close SaveChanges:=False
    End If

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

@Override
public int compareTo(Card other) {
    return <some code to determine which card is "higher">();
}

将工作表从另一个工作簿（＃2）导入当前工作簿（＃1）

1 个答案: