VBA列表框:检查列表框项是否已在指定的工作表范围内,并在下一个空单元格中写入列表框项

时间:2016-05-09 11:44:28

标签: vba listbox listboxitem is-empty

标题似乎有点复杂,但我会尝试用步骤解释(我想要VBA代码做什么):

  1. 只读列表中的一个列表项
  2. 如果此项目已在我的工作表的第1列(列(1))中,请跳过步骤3和4.
  3. 如果此项目不在第1列(列(1))中,请检查该列中的第一个空单元格(从顶部读取)
  4. 当找到下一个空单元格时,复制该空单元格中此列中尚未存在的项目
  5. 继续下一个项目
  6. 到目前为止我所拥有的是以下代码:

    Private Sub Tab1_Done_Button_Click()
        Dim ws As Worksheet
        Dim i As Integer
        Dim listItem As Variant  
    
        For listItem = 0 To Me.Tab1_Product_Picked.ListCount - 1
              'Check If The Product Is Already There (Dont't Create Duplicate)
               For i = 4 To 400
               If ws.Cells(i, 1).Value <> Me.Tab1_Product_Picked.List(listItem) Then
                       'Write In First Empty Cell In 1st Column If Not Duplicate
                       For Each cell In ws.Columns(1).Cells
                           If IsEmpty(cell) = True Then
                                cell.Value = Me.Tab1_Product_Picked.List(listItem)
                                Exit For
                           End If
                       Next cell
                       Exit For
                 End If
            Next i
        Next listItem
    End Sub
    

    我在这里显然犯了一个逻辑错误,正如下面发生的那样:

    我已经在第一栏中有产品3,产品5和产品6。我在我的表单中转到列表框,经过几次操作后,我最终得到了列表框中的以下项目:产品3,产品6和产品7.我希望代码能够在下一次转移产品7第1列中的空单元格,但它当前所做的是它仍然从列表框中传输所有产品,毕竟这是我在第一列中所拥有的:产品3,产品5,产品6,产品3,产品6,产品7。 这意味着代码能够识别第一行中的空单元格,它能够从列表框中读取数据,它能够从列表框中复制数据并根据需要将其粘贴到空单元格中,但是无法检查列表框中的产品是否已位于第1列的其中一个单元格中。

    提前感谢您提供有关如何修复代码需要检查重复项的部分的任何建议。

    干杯谢谢!

1 个答案:

答案 0 :(得分:0)

我已经用另一种方式重写了代码,所以现在它做了它应该做的事情。经测试且一切正常:

Range("A:A").Select
        For listItem = 0 To Me.Tab1_Product_Picked.ListCount - 1
                If Selection.Find(What:=Me.Tab1_Product_Picked.List(listItem), LookIn:=xlValues) Is Nothing Then
                    For Each cell In Columns(1).Cells
                        If IsEmpty(cell) = True Then
                            cell.Value = Me.Tab1_Product_Picked.List(listItem)
                            Exit For
                        End If
                    Next cell
                End If
        Next listItem

我会把这个留在这里以防万一有人遇到同样的问题:)