VBA Excel - 导入两个工作表 [英] VBA Excel - import two worksheets

问题描述

我找到了下面的代码，它适用于我需要它做的事情。  但是，当它检查第二个工作表时， 

 设置ws =工作表（sWSName） 会说" <下标超出范围>

所以，我可以导入第一个工作表，但不能导入第二个工作表。

感谢您的帮助。

私函数SheetExists（sWSName As String）作为布尔值

  &NBSP; Dim ws As Worksheet

  &NBSP; On Error Resume Next

  &NBSP;设置ws =工作表（sWSName）

  &NBSP;如果Not Ws Is Nothing则SheetExists = True

结束函数



$
Private Sub CommandButton1_Click（）

  &NBSP; Dim sImportFile As String，sFile As String

  &NBSP; Dim sThisBk As Workbook

  &NBSP; Dim vfilename As Variant

    

    

  &NBSP; Application.ScreenUpdating = False

  &NBSP; Application.DisplayAlerts = False

  &NBSP;设置sThisBk = ActiveWorkbook

  &NBSP; sImportFile = Application.GetOpenFilename（_

   FileFilter：=" Microsoft Excel Workbooks，* .xls; * .xlsx"，Title：=" Open Workbook"）

  &NBSP;如果sImportFile =" False"然后

  &NBSP; &NBSP; &NBSP; MsgBox"未选择文件！"左右b $ b  &NBSP; &NBSP; &NBSP;退出Sub $
  &NBSP; &NBSP; &NBSP;  

  &NBSP;否则

  &NBSP; &NBSP; &NBSP; vfilename = Split（sImportFile，" \"）

  &NBSP; &NBSP; &NBSP; sFile = vfilename（UBound（vfilename））

  &NBSP; &NBSP; &NBSP; Application.Workbooks.Open Filename：= sImportFile

  &NBSP; &NBSP; &NBSP;  

  &NBSP; &NBSP; &NBSP;设置wbBk =工作簿（sFile）

  &NBSP; &NBSP; &NBSP;随着wbBk

$
  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;如果SheetExists（"一般信息"）则为
  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;设置wsSht = .Sheets（"一般信息"）

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; wsSht.Copy after：= sThisBk.Sheets（" Admin"）

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;否则

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; MsgBox"没有名称的表格：一般信息：" &安培; vbCr& .Name

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;结束如果



  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;如果SheetExists（"调查"）则为
  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;设置wsSht = .Sheets（" Survey"）

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; wsSht.Copy after：= sThisBk.Sheets（"General Information"）

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;否则

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; MsgBox"没有名称的工作表：调查在：" &安培; vbCr& .Name

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;结束如果




  &NBSP; wbBk.Close SaveChanges：= False

    

    

  &NBSP;结束与$
  &NBSP;结束如果

  &NBSP; Application.ScreenUpdating = True

  &NBSP; Application.DisplayAlerts = True

结束次级

解决方案

使用不合格的工作表对象可能意味着您正在查找错误的工作簿。最好还使用工作簿对象..此外，Sheets集合与Worksheets集合不同，因为Sheets包括图表（以及任何
宏和对话表 - 从史前Excel中保留）





Sub TestMacro（）

'   如果SheetExists（wbBk，"Survey"等）则为
'   如果SheetExists（ThisWorkbook，"Survey"）那么
b $ b  &NBSP;如果SheetExists（ActiveWorkbook，"Survey"）则为
  &NBSP; &NBSP; &NBSP; MsgBox"它存在。"

  &NBSP;否则

  &NBSP; &NBSP; &NBSP; MsgBox"Nope ...."&b
  &NBSP;结束如果

结束子



私函数SheetExists（WB As Workbook，sWSName As String）As Boolean

&NBSP; &NBSP; Dim ws As Worksheet

  &NBSP; On Error Resume Next

  &NBSP;设置ws = WB.Worksheets（sWSName）

  &NBSP;如果没有，那么SheetExists = True

结束功能

I found the below code, and it works for what I need it to do.   However, when it checks for the 2nd worksheet,  

 Set ws = Worksheets(sWSName)  will say " <subscript out of range>

so, I am able to import the first worksheet , but not the second.

Thank you for your help.

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


Private Sub CommandButton1_Click()
    Dim sImportFile As String, sFile As String
    Dim sThisBk As Workbook
    Dim vfilename As Variant
    
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set sThisBk = ActiveWorkbook
    sImportFile = Application.GetOpenFilename( _
    FileFilter:="Microsoft Excel Workbooks, *.xls; *.xlsx", Title:="Open Workbook")
    If sImportFile = "False" Then
        MsgBox "No File Selected!"
        Exit Sub
         
    Else
        vfilename = Split(sImportFile, "\")
        sFile = vfilename(UBound(vfilename))
        Application.Workbooks.Open Filename:=sImportFile
         
        Set wbBk = Workbooks(sFile)
        With wbBk

            If SheetExists("General Information") Then
                Set wsSht = .Sheets("General Information")
                wsSht.Copy after:=sThisBk.Sheets("Admin")
            Else
                MsgBox "There is no sheet with name :General Information in:" & vbCr & .Name
            End If

            If SheetExists("Survey") Then
                Set wsSht = .Sheets("Survey")
                wsSht.Copy after:=sThisBk.Sheets("General Information")
            Else
                MsgBox "There is no sheet with name :Survey in:" & vbCr & .Name
            End If


    wbBk.Close SaveChanges:=False
    
    
    End With
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

解决方案

Using an unqualified sheet object may mean you are looking in the wrong workbook. Better to use the workbook object as well..  Further, the Sheets collection is not the same as the Worksheets collection, since Sheets includes Charts (as well as any Macro and Dialog sheets - holdovers from prehistoric Excel)


Sub TestMacro()
'    If SheetExists(wbBk, "Survey") Then
'    If SheetExists(ThisWorkbook, "Survey") Then
    If SheetExists(ActiveWorkbook, "Survey") Then
        MsgBox "It exists."
    Else
        MsgBox "Nope...."
    End If
End Sub

Private Function SheetExists(WB As Workbook, sWSName As String) As Boolean
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = WB.Worksheets(sWSName)
    If Not ws Is Nothing Then SheetExists = True
End Function

这篇关于VBA Excel - 导入两个工作表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！