从列表框中计算和返回重复项答案

【问题标题】：Counting and returning duplicates from Listbox从列表框中计算和返回重复项
【发布时间】：2017-12-11 09:49:06
【问题描述】：

我在 MS Access 2016 中有一个列表框 (Listbox1)，其中包含 1 列 - ActualDate。

此列包含许多日期，其中一些是重复的。

这个列表框的行源是

Set rs = CurrentDb.OpenRecordset("SELECT q.ActualDate FROM TBLQUOTESNEW q WHERE q.ActualDate >= #12/01/2017# order by q.ActualDate")

我需要在同一个表单上填充另一个列表框 (Listbox2)，它有 2 列 - ActualDate 和 Count - 其中 Count 是 Listbox1 中包含日期的选定行数。

所以 Listbox1 可以是：-

如果选择了所有 4 行，Listbox2 应该返回

13/01/2017    2
14/01/2017    2

我不确定实现这一目标的最佳方法。我已经能够创建一个具有唯一日期的数组，但是从那里我很难过。

【问题讨论】：

第一个组合框的行源是什么？您也许可以使用简单的查询而不是复杂的 VBA 解决方案。
@ErikvonAsmuth 添加了源代码
您只对选定的行感兴趣，而不是实际的重复数量，例如如果一个日期被选择了 2 次但出现了 3 次，你想将计数显示为 2？
@ErikvonAsmuth 是的，没错。

标签： ms-access vba

【解决方案1】：

您可以使用以下子程序：

Public Sub MoveListBoxItems(lstDestination As ListBox, lstSource As ListBox)
    Dim intListItem As Long
    Dim lastItem As String
    Dim itemAmount As Long
    'Set these using the property pane, then remove them from the VBA
    lstDestination.RowSource = ""
    lstDestination.RowSourceType = "Value List"
    lstDestination.ColumnCount = 2
    For intListItem = 0 To lstSource.ListCount - 1 'iterate through the whole list
        If lstSource.Selected(intListItem) Then 'If the item is selected
            If lstSource.ItemData(intListItem) = lastItem Then 'If the current item is equal to the last one
                itemAmount = itemAmount + 1 'Increment the amount by 1
            Else
                If itemAmount <> 0 Then 'If it isn't a non-occuring list item (first iteration
                    lstDestination.RowSource = lstDestination.RowSource & """" & lastItem & """;""" & itemAmount & """;"
                End If 'Add the item
                lastItem = lstSource.ItemData(intListItem) 'Last item = current item, amount = 1
                itemAmount = 1
            End If
        End If
    Next intListItem
    If itemAmount <> 0 Then 'If it isn't a non-occuring list item
        lstDestination.RowSource = lstDestination.RowSource & """" & lastItem & """;""" & itemAmount & """;"
    End If 'Add the last item
End Sub

这样称呼它：MoveListBoxItems Me.Listbox2, Me.Listbox1

注意它带有一些假设，即：列表必须有序，列表不能包含任何引号（否则您需要添加引号转义）

【讨论】：

【解决方案2】：

如果是列表框，我会使用子表单。基于带有附加列“已选择”的临时表的子表单，用户使用复选框选择记录。在这种情况下，根据临时表中的分组查询，将很容易显示第二个列表框或子表单

【讨论】：