比较数组与 Table

Question

我的目标是在特定条件下将 WorkbookA 中的 Worksheets(ws1...wsn) 加载到 WorkbookB。我在 WorkbookA 中形成了一组工作表。

条件：
我在 WorkbookB 中有一个 table(tblList)，它列出了必须忽略加载的工作表名称（假设我不想加载 ws2,ws4).

Set SourceDataWorkbook = Workbooks.Open(vSrcFileName)
validationProd = SourceDataWorkbook.Sheets.Count

ReDim arrsNames(validationProd)
For i = 1 To validationProd
sName = ""

If fCheckSheet(SourceDataWorkbook, SourceDataWorkbook.Sheets(i).Name) Then
    sName = SourceDataWorkbook.Sheets(i).Name
    If Len(Trim(sName)) > 30 Then
    sName = Mid(sName, 1, 29)
End If
    arrsNames(i - 1) = sName
    outputWorkbook.Sheets.Add(After:=outputWorkbook.Worksheets(i + 3)).Name = _
        sName + "_P"
    SourceDataWorkbook.Sheets(i).Activate
Else
    ErrorStatus = "Source Sheet not found "
    msgBoxReturn = MsgBox(ErrorStatus & SourceDataWorkbook.FullName, _
        vbExclamation + vbOKCancel)
    GoTo TheExit:
End If

请帮助我达到要求。

Answer 1

您的代码有很多挂起语句（For Loop 和 If Statements）。
我不知道你所说的负载是什么意思，但是如果你想要从不在列表中的 WorkbookA 复制 Worksheets（table in sheet in WorkbookB），你可以尝试以下：

工作中的代码sheetB:

Dim sourcewb As Workbook, destwb As Workbook
Dim ws As Worksheet
Set sourcewb = Workbooks("workbookname") 'or using Open method
Set destwb = ThisWorkbook 'contains your table

For Each ws In sourcewb.Sheets
    If IsError(Application.Match(ws.Name, Sheet1.Range("tblList"), 0)) Then
        ws.Copy , destwb.Sheets(destwb.Sheets.Count) 'copy after last sheet
    End If
Next

这是假设您的 table 只有 1 列，如下所示：

如果没有，您应该像下面这样包含 header：

If IsError(Application.Match(ws.Name, Sheet1.Range("tblList[List]"), 0)) Then

请注意，Sheet1 是包含您的 table 的作品sheet 代号。
它可以替换为 destwb.Sheets("Sheet1") 或您的 sheet 的任何名称。
这是您要尝试的吗？ HTH.

Answer 2

L42 的替代解决方案。 abpve问题可以用Dictionary来实现。

Public Function ExclutionDict(Table As String) As Dictionary

Dim rngTable As Range
Dim arr As Variant
Dim Dict As Dictionary
Dim Count As Long
Dim tblIgnoreLoad As String
Dim lo As Excel.ListObject
Dim test As String

If Table = "tblIgnoreLoad" Then
Set lo = ShControl.ListObjects("tblIgnoreLoad")
Set rngTable = lo.DataBodyRange

    arr = rngTable.Value
    Set Dict = New Dictionary

    For Count = LBound(arr, 1) To UBound(arr, 1)
     If Len(arr(Count, 1)) <> 0 Then
         Dict.Add arr(Count, 1), Count
     End If
    Next Count
End If
Set ExclutionDict = Dict
End Function

以上功能可以满足要求

Dim temp As Dictionary
    Set temp = ShControl.ExclutionDict("tblIgnoreLoad")

     If temp.Exists(SourceDataWorkbook.Sheets(i).name) Then
      'Do Nothing

     Else 
  ' Do you usual copy/load
end if

将table转化为字典，列表作为数组。验证条件以检查字典中是否存在工作表，什么也不做；否则复制。

注意：请不要忘记添加 Microsoft Scripting Runtime 的引用以启用字典属性。

谢谢。

比较数组与 Table

Comparing Array versus Table

vba

excel

excel-2007