Question

我试图遍历excel中列表框的多选列表。但它会引发错误“下一个没有For” UserForm连接三本书。首先，宏应检查“ToolsDır”书中是否有匹配项。如果有工具，则将其从负责人转移到收件人。然后在“ TOOLSJOURNAL”中输入此交易。然后浏览列表框的所有选定元素，并执行相同的操作。我希望我能解释这个问题

Private Sub cmbOK_Click()
    Dim wbd, wbs As String
    wbd = "...\TOOLS\TOOLSJOURNAL.xlsm"
    wbs = "...\TOOLS\TOOLSDIR.xlsm"
    If Trim(Me.cboCity.Value) = "" Or Trim(Me.cboReciever.Value) = "" Then
        Me.TextDate.SetFocus
        MsgBox ("Tool is already in use!")
    Else
        GetObject (wbs)
        Dim lnItem  As Long

        For lnItem = 0 To Me.ListBox.ListCount - 1
            If Me.ListBox.Selected(lnItem) Then
                Dim ws As Worksheet
                Set ws = Workbooks("TOOLSDIR").Worksheets("TABLE")
                Dim rn1, rn2, rn3 As Range
                Set rn1 = ws.Range("ID")
                Set rn2 = ws.Range("EMPLOYEES")
                Set rn3 = ws.Range("DATA")
                Dim i, j, k, l As Integer

                i = Application.Match(Me.ListBox.Selected(lnItem), ws.Range("ID"), 0)
                j = Application.Match(Me.cboRespName.Value, ws.Range("EMPLOYEES"), 0)
                k = Application.Match(Me.cboRecName.Value, ws.Range("EMPLOYEES"), 0)
                l = rn3.Cells(i, j)

                If rn3.Cells(i, j).Value <> 1 Then
                    MsgBox ("Fill Blank ")
                    Application.DisplayAlerts = False
                    Workbooks("TOOLSDIR").Close (False)
                Else: rn3.Cells(i, j) = rn3.Cells(i, j) - 1
                    rn3.Cells(i, k) = rn3.Cells(i, k) + 1
                End If

                Application.DisplayAlerts = False
                Workbooks("TOOLSDIR").Close (True)

                With GetObject(wbd)
                    Dim Database As Worksheet
                    Set Database = Workbooks("TOOLSJOURNAL").Worksheets("JOURNAL")
                    Dim NextRow As Long
                    NextRow = Database.Cells(Database.Rows.Count, 3).End(xlUp).Offset(1, 0).Row

                    If Database.Range("B4").Value = "" And Database.Range("C4").Value = "" Then
                        NextRow = NextRow - 1
                    End If


                    Database.Cells(NextRow, 3).Value = Me.TextDate.Value
                    Database.Cells(NextRow, 4).Value = Me.TextPurchaseDate
                    Database.Cells(NextRow, 5).Value = Me.TextFirstDate.Value
                    Database.Cells(NextRow, 6).Value = Me.TextDayTotal.Value
                    Database.Cells(NextRow, 7).Value = Me.cboRegion.Value
                    Database.Cells(NextRow, 8).Value = Me.cboCity.Value
                    Database.Cells(NextRow, 9).Value = Me.cboResponsible.Value
                    Database.Cells(NextRow, 10).Value = Me.cboRespName
                    Database.Cells(NextRow, 11).Value = Me.ListBox.List(lnItem, 1).Value
                    Database.Cells(NextRow, 12).Value = Me.ListBox.List(lnItem, 2).Value
                    Database.Cells(NextRow, 13).Value = Me.ListBox.List(lnItem, 3).Value
                    Database.Cells(NextRow, 14).Value = Me.cboReciever.Value
                    Database.Cells(NextRow, 15).Value = Me.cboRecName.Value
                    Database.Range("B4").Formula = "=If(ISBLANK(C4), """", COUNTA($C$4:C4))"

                    If NextRow > 4 Then
                        Workbooks("TOOLSJOURNAL").Worksheets("JOURNAL").Activate
                       Workbooks("TOOLSJOURNAL").Worksheets("JOURNAL").Range("B4").Select
                        Selection.AutoFill Destination:=Range("b4:b" & NextRow)
                        Range("b4:b" & NextRow).Select
                    End If
                End With

                Application.DisplayAlerts = False
                Workbooks("TOOLSJOURNAL").Close (True)


        Next lnItem
    End If

    Call resetForm
End Sub

遍历列表框多选

0 个答案: