Arrays 创建新工作簿的数组的VBA编码问题

好吧，我之前的帖子没有得到任何回复，可能是因为我的编码太复杂了。我在以前的文章中已经解决了大部分问题，但是，我还有一个问题我仍在努力解决。当用户从我的列表框（Me.Submissionlist）中选择多个项目时，阵列将无法识别。相反，该程序生成两个工作表：索引0和1的选择。我需要multiselect引用代码中的数组，并引入一个新工作簿，该工作簿生成代码中标注的数组。请帮帮我。以下是代码（我将此问题解释为：

---

只需查看您的代码：

    ....
    Dim Select1, Select2 As Integer
    For Select1 = 0 To Me.Submissionlist.ListCount - 1
      If Me.Submissionlist.Selected(Select1) = True Then
        For Select2 = 1 To Me.Submissionlist.ListCount - 1
          If Me.Submissionlist.Selected(Select1) = True Then
            If Me.Submissionlist.Selected(Select2) = True Then
              Me.Submissionlist.Selected(Select1 And Select2) = True
              Sheets("SubmissionProperty").Visible = False
              Sheets("SubmissionLiabilty").Visible = False
              ThisWorkbook.Worksheets(Array("Client_Profile", "SubmissionProperty", "SubmissionLiabilty")).Copy
              Sheets("SubmissionProperty").Visible = True
              Sheets("SubmissionLiabilty").Visible = True
              Worksheets("Client_Profile").Move Before:=Worksheets(1)
              Worksheets("Client_Profile").Activate
            End If
            Exit For '<~~~ will always be activated
          End If
          If selCount = -1 Then
            Me.Submissionlist.Selected(Select1) = False
            Me.Submissionlist.Selected(Select2) = False
            ....

它在第一个循环中自动消失

编辑：虽然我仍然不知道您到底想要什么，但我创建了2个Sub，这可能会帮助您：

---

此工作簿为每个选定项目创建一个新工作簿（保存选定项目和“SubmissionProperty”）

---

这只会创建一个新的wb，其中包含“SubmissionProperty”和列表中的所有选定项

Private Sub CMDSubSelector_2_Click()
  SubmissionSelector.Hide
  Dim subArr As Variant
  subArr = Array("SubmissionProperty", "SubmissionLiabilty", "Sheet1", "Sheet2", "Sheet3", "Sheet4")
  Dim subCol() As Variant
  ReDim subCol(0)
  subCol(0) = "Client_Profile"
  Dim i As Long
  With Me.Submissionlist
    For i = 0 To .ListCount - 1
      If .Selected(i) = True Then
        ReDim Preserve subCol(0 To UBound(subCol) + 1)
        subCol(UBound(subCol)) = subArr(i)
      End If
    Next i
    Sheets(subCol).Visible = False
    ThisWorkbook.Worksheets(subCol).Copy
    Sheets(subCol).Visible = True
    Worksheets("Client_Profile").Move Before:=Worksheets(1)
    Worksheets("Client_Profile").Activate
  End With
End Sub

---

---

希望这对您有所帮助：）

您能分享列表框中项目的示例详细信息、它们的选择状态、预期输出和实际输出吗？列表框包含14个项目。每个项目都会生成一个由数组定义的新工作簿。但是所有的

用于。。。下一步

在第一个循环中自杀。。。对我来说没有意义…因此，每个项目都会将现有工作表引入到为客户机生成的新工作簿中。客户_档案工作表始终包含在所有选择中，根据单个或多个选择，其他工作表会有所不同。哦。我的印象是，我正在停止活动，重新开始一项新的活动。我对编码还不熟悉，我仍然误解了很多术语。如果我为移除出口，我应该为丢失出口。该活动为单个选择生成多个Workbook。当我将出口放回时，单个选择会识别该数组并生成一个表示该数组的工作簿。对于多重选择，它无法识别带或不带出口的阵列@Liz我看到我身上有多个

。I=1对我的Submissionlist.Submissionlist.ListCount-1

循环，这可能会创建多个工作簿哦，好的。我会调整这个，看看会发生什么。谢谢你的回复。我真的很感激。Nimesh，我从代码的每一行中删除了.Submissionlist，我仍然得到了相同的结果，忽略了multiselect的数组，并生成了索引0和索引1的工作表。

For i = 0 To Me.Submissionlist.ListCount - 1
  If Me.Submissionlist.Selected(i) = True Then
    ....
  End If
  Exit For '<~~~ will always be activated
Next i

Private Sub CMDSubSelector_1_Click()
  SubmissionSelector.Hide
  Dim subArr As Variant
  subArr = Array("SubmissionProperty", "SubmissionLiabilty", "Sheet1", "Sheet2", "Sheet3", "Sheet4")
  Dim i As Long
  With Me.Submissionlist
    For i = 0 To .ListCount - 1
      If .Selected(i) = True Then
        Sheets(subArr(i)).Visible = False
        ThisWorkbook.Worksheets(Array("Client_Profile", subArr(i))).Copy
        Sheets(subArr(i)).Visible = True
        Worksheets("Client_Profile").Move Before:=Worksheets(1)
        Worksheets("Client_Profile").Activate
      End If
    Next i
  End With
End Sub

Private Sub CMDSubSelector_2_Click()
  SubmissionSelector.Hide
  Dim subArr As Variant
  subArr = Array("SubmissionProperty", "SubmissionLiabilty", "Sheet1", "Sheet2", "Sheet3", "Sheet4")
  Dim subCol() As Variant
  ReDim subCol(0)
  subCol(0) = "Client_Profile"
  Dim i As Long
  With Me.Submissionlist
    For i = 0 To .ListCount - 1
      If .Selected(i) = True Then
        ReDim Preserve subCol(0 To UBound(subCol) + 1)
        subCol(UBound(subCol)) = subArr(i)
      End If
    Next i
    Sheets(subCol).Visible = False
    ThisWorkbook.Worksheets(subCol).Copy
    Sheets(subCol).Visible = True
    Worksheets("Client_Profile").Move Before:=Worksheets(1)
    Worksheets("Client_Profile").Activate
  End With
End Sub