Question

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

Option Explicit

Private Sub CMDSubSelector_Click()
  SubmissionSelector.Hide
  On Error Resume Next

  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationAutomatic

  Dim wbNew As Workbook
  Set wbNew = ActiveWorkbook

  Dim i As Integer
  Dim selCount As Integer
  selCount = -1

  With Me.Submissionlist
    For i = 0 To Me.Submissionlist.ListCount - 1
      If Me.Submissionlist.Selected(i) = True Then
        Sheets("SubmissionProperty").Visible = False
        ThisWorkbook.Worksheets(Array("Client_Profile", "SubmissionProperty")).Copy
        Sheets("SubmissionProperty").Visible = True
        Worksheets("Client_Profile").Move Before:=Worksheets(1)
        Worksheets("Client_Profile").Activate
      End If
      Exit For
    Next i

    If selCount = -1 Then
      Me.Submissionlist.Selected(i) = False
      Me.Submissionlist.Clear
      With Me.Submissionlist
        For i = 1 To Me.Submissionlist.ListCount - 1
          If Me.Submissionlist.Selected(i) = True Then
            Sheets("SubmissionLiabilty").Visible = False
            ThisWorkbook.Worksheets(Array("Client_Profile", "SubmissionLiabilty")).Copy
            Sheets("SubmissionLiabilty").Visible = True
            Worksheets("Client_Profile").Move Before:=Worksheets(1)
            Worksheets("Client_Profile").Activate
          End If
          Exit For
        Next

        If selCount = -1 Then
          Me.Submissionlist.Selected(i) = False
          Me.Submissionlist.Clear
          With Me.Submissionlist
            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
                  End If

                  If selCount = -1 Then
                    Me.Submissionlist.Selected(Select1) = False
                    Me.Submissionlist.Selected(Select2) = False
                    Me.Submissionlist.Clear
                    If Me.Submissionlist.Value Then Unload Me
                    Application.ScreenUpdating = True
                  End If
                Next
              End If
            Next
          End With
        End If
      End With
    End If
  End With
End Sub

Answer 1

只看你的代码：

    ....
    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
            ....

第二个周期只有在Me.Submissionlist.Selected(Select1) = True没有问题的情况下才能启动，但第二个周期中的第一个If是：If Me.Submissionlist.Selected(Select1) = True Then由于true总是true事实上只有If Me.Submissionlist.Selected(Select2) = True Then才能导致这一点。现在出现了一些我根本无法理解的东西：在你的Exit For之后（它本身仍然没问题）有一个If（我跳过了第二个）。知道第二个圆圈中的第一个true总是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

它在第一个周期消除了自己......

编辑：虽然我仍然不知道你想要什么，但我创造了2个可能对你有帮助的潜艇：

这个为每个项目创建一个新的工作簿（包含所选项目和＆＃34; SubmissionProperty＆＃34;）

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

这个只创建一个新的wb持有＆＃34; SubmissionProperty＆＃34;以及列表中的所有选定项目

<?php 

DEFINE('LIBS', 'app/Libs/');

希望这对你有所帮助:)。

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

1 个答案: