VBA中的可排序列表？

Question

有没有办法创建一个允许用户订购商品的VBA用户界面？请参阅从pdf编辑器中获取的示例图像。

我希望我的用户能够在弹出窗口或列表中订购数据，并将他们的订单输出到其他位置。数据是建筑物清单。

谢谢！

Answer 1

对于此解决方案，我使用了UserForm ListBox和SpinButton控件。

我在Sheet1的A列的列表框中放置了我想要的单元格列表。我通过Building 1拥有通用的Building 2，Building 19等，以便我的数据包含在A1:A19的{​​{1}}范围内。这是任意的，您应该根据自己的需要进行调整。

此代码基本上存储包含Sheet1项目的原始RowSource，从ListBox删除RowSource，重新排列基础源数据，然后重新用户在ListBox

上向上或向下点击后，将RowSource应用于新订单中的ListBox

我没有更改默认控件名称（SpinButton，UserForm1，SpinButton1）。

1. 打开VB编辑器（开发人员选项卡 - ＆gt; Visual Basic或按 ALT + F11
2. 右键单击Microsoft Excel对象 - ＆gt;插入 - ＆gt;用户窗体
3. 添加ListBox1和SpinButton，以便UserForm看起来像这样
4. 在VB编辑器中，右键单击“表单”下的ListBox - ＆gt;查看代码

5. 将以下代码粘贴到

   中

   UserForm1

我试图添加评论以澄清我在做什么。这是一种稍微麻烦的方法，并根据可用的代码here进行了改编。如果单击Debug（看起来像播放）按钮，则表单应显示并填充Sheet1的单元格A1：A19的值。然后，您可以在Private Sub UserForm_Initialize() 'Populate the UserForm with data from range A1:A19 (arbitrary, change to suit your needs ListBox1.RowSource = Sheet1.Range(Sheet1.Range("A1"), Sheet1.Range("A1").End(xlDown)).Address End Sub Private Sub SpinButton1_SpinDown() With ListBox1 If .ListIndex = .ListCount - 1 Then Exit Sub 'No item selected or we are in the last position lCurrentListIndex = .ListIndex + 1 'Get the current position of the item strRowSource = .RowSource 'Get the current row source strAddress = Range(strRowSource).Address 'Address of the row source range strSheetName = Range(strRowSource).Parent.Name 'Grab the parent sheet name .RowSource = vbNullString 'Empty the listbox 'Re-arrange the underlying data With Range(strRowSource) .Rows(lCurrentListIndex).Cut .Rows(lCurrentListIndex + 2).Insert Shift:=xlDown End With 'Re-apply the row source .RowSource = strRowSource 'For continuity, select the previously selected element in its new position .Selected(lCurrentListIndex) = True End With End Sub Private Sub SpinButton1_SpinUp() Dim lCurrentListIndex As Long Dim strRowSource As String Dim strAddress As String Dim strSheetName As String With ListBox1 If .ListIndex < 1 Then Exit Sub 'No item selected or we are in the first position lCurrentListIndex = .ListIndex + 1 strRowSource = .RowSource strAddress = Range(strRowSource).Address strSheetName = Range(strRowSource).Parent.Name .RowSource = vbNullString With Range(strRowSource) .Rows(lCurrentListIndex).Cut .Rows(lCurrentListIndex - 1).Insert Shift:=xlDown End With .RowSource = strRowSource .Selected(lCurrentListIndex - 2) = True End With End Sub 中选择一个项目，然后按ListBox的向上或向下按钮，以便在列表中上下移动项目。一个重要的假设是SpinButton上MultiSelect 已停用。

通常我不会在没有看到你尝试过的情况下发布这样一个深入的解决方案，但这个问题激起了我的好奇心。