空白单元格在执行代码时包含值

时间:2015-12-31 04:12:58

标签: excel-vba vba excel

我正在使用带有12个列表框的用户表单(编号为2-13)。每个列表框可以包含用户从主listbox1分配的0-8个项目。当按下按钮时,我运行以下代码将每个列表框的内容(12个框)输出到工作表“Tray”。

然后将每个列表框输出到来自列B-M的每个托盘的相应列中。 Listbox2填充每个托盘的第1列,依此类推。最多可以装满4个托盘。代码检查每个托盘的第一个孔,如果它包含一个值,则假定托盘已满并且开始填充下一个托盘。

问题:如果第一个托盘包含空白列(列表框),而第二个托盘包含相同列表框中的值,则代码将填充第一个托盘的空白列,其值应位于第二个托盘中。请参阅下面的图片和下面的更新代码:

纸盘1的列表框2,3和4(注释列表框3为空)

enter image description here

托盘2的列表框2,3和4(注释列表框3有数据)

enter image description here

代码运行了两次:来自tray2的Listbox3出现在tray1中(错误!!!)

enter image description here

预期产出:

enter image description here

Sub Worklist()
'
Dim Var, VarName As Variant
Dim i, DblDashPos, FirstPeriodPos, lngColNum, lngRowNum As Long
Dim item As ListBox

Const cstrNames As String = "Listbox2,Listbox3,Listbox4,Listbox5,Listbox6,Listbox7,Listbox8,Listbox9,Listbox10,Listbox11,Listbox12,Listbox13"

Application.ScreenUpdating = False

lngColNum = 2

For Each VarName In Split(cstrNames, ",")


    If UserForm2.Controls(VarName).ListIndex <> -1 Then 'if listbox is not blank

        If Sheets("Tray").Cells(4, lngColNum).Value = 0 Then
        'checks if value in row 3 column "lngColNum" is empty
            lngRowNum = 4
            ThisWorkbook.Sheets("Tray").Range("C2").Value = UserForm2.TextBox1.Value

        ElseIf Sheets("Tray").Cells(15, lngColNum).Value = 0 Then 'checks if value in row 14 column "lngColNum" is empty

            lngRowNum = 15

            ThisWorkbook.Sheets("Tray").Range("C13").Value = UserForm2.TextBox1.Value

        ElseIf Sheets("Tray").Cells(26, lngColNum).Value = 0 Then 'checks if value in row 14 column "lngColNum" is empty

            lngRowNum = 26

            ThisWorkbook.Sheets("Tray").Range("C24").Value = UserForm2.TextBox1.Value

        Else 'otherwise assumes tray starts in row 5, column "lngColNum"

            lngRowNum = 37
            ThisWorkbook.Sheets("Tray").Range("C35").Value = UserForm2.TextBox1.Value

        End If


        For i = 0 To UserForm2.Controls(VarName).ListCount - 1
            Var = UserForm2.Controls(VarName).List(i)

            DblDashPos = InStr(1, Var, "--")
            FirstPeriodPos = InStr(1, Var, ".")
            Sheets("Tray").Select
            ActiveSheet.Cells(lngRowNum, lngColNum) = Left(Var, DblDashPos - 1) & Right(Var, Len(Var) - FirstPeriodPos + 1)

            lngRowNum = lngRowNum + 1
        Next i

    End If


    lngColNum = lngColNum + 1

Next

Application.ScreenUpdating = True

End Sub

非常感谢!

1 个答案:

答案 0 :(得分:1)

问题是您只测试与ListBox对应的列以查看该单元格是否为空。如果您想测试&#34;托盘中的所有列?是空的,你需要为整张纸测试一次。这样的事情(未经测试,因为我懒得重建你的表格):

Private Function FindFirstUnusedRow(sheet As Worksheet) As Long
    Dim testColumn As Long, testRow As Long
    Dim used As Boolean

    For testRow = 4 To 37 Step 11
        used = False
        For testColumn = 2 To 13
            If IsEmpty(sheet.Cells(testRow, testColumn)) = False Then
                used = True
                Exit For
            End If
        Next testColumn
        If used = False Then
            FindFirstUnusedRow = testRow
            Exit For
        End If
    Next testRow
End Function

然后在你的代码中,在循环之前调用它:

Sub Worklist()
    Dim var As Variant
    Dim i As Long, dashPos As Long, periodPos As Long, colNum As Long
    Dim rowNum As Long, Dim sheet As Worksheet

    Application.ScreenUpdating = False
    Set sheet = ThisWorkbook.Sheets("Tray")
    rowNum = FindFirstUnusedRow(sheet)

    If rowNum = 0 Then
        Debug.Print "All trays full."
        Exit Sub
    End If

    Dim current As ListBox
    For colNum = 2 To 13
        Set current = UserForm2.Controls("Listbox" & colNum)
        If current.ListIndex <> -1 Then 'if listbox is not blank
            sheet.Cells(rowNum - 2, colNum).Value = UserForm2.TextBox1.Value
            For i = 0 To current.ListCount - 1
                var = current.List(i)
                dashPos = InStr(1, var, "--")
                periodPos = InStr(1, var, ".")
                sheet.Cells(rowNum + i, colNum) = Left$(var, dashPos - 1) & _
                                    Right$(var, Len(var) - periodPos + 1)
            Next i
        End If
    Next colNum
    Application.ScreenUpdating = True
End Sub

其他一些注意事项:您可以完全抛弃Sheets("Tray").Select行 - 您永远不会使用选择对象。对ActiveSheetThisWorkbook.Sheets("Tray")的混合引用也是如此。抓住一个参考并使用它。

此外,这些行不会按照您的想法行事:

Dim Var, VarName As Variant
Dim i, DblDashPos, FirstPeriodPos, lngColNum, lngRowNum As Long

在您声明的所有变量中,除了Variant之外,所有都是lngRowNum。如果你想在一行上组合声明,你仍然需要为每个变量指定一个类型,或者他们默认为Variant。请参阅上面的示例代码。