Question

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

此列包含大量日期，其中一些日期重复。</ p>

此列表框的rowsource是

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

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

Answer 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

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

Answer 2

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

从Listbox计算并返回重复项

2 个答案: