完美Excel

在使用Google搜索时，当在输入框中输入时，下方会出现相关条目供选择，以方便快速输入。下面，我们在Excel用户窗体中使用文本框和列表框来仿造这样的效果。
有时，当用户窗体中的列表框包含大量的项目时，我们必须拖动其滚动条来查找相应的项目。然而，可以利用一些技巧快速找到所需的项目。
如图1所示，在用户窗体中，放置有两个控件，上方为一名为txtFind的文本框，下方为一名为lbxData的列表框，列表框的数据来自工作表Data的列A中的数据。

图1
当我在上方的文本框txtFind中输入“excel vba”后，下方的列表框lbxData将只出现包含有“excel vba”的条目，如图2所示。

图2
实现上述效果的VBA代码如下：
Option Explicit
Dim varData

Private Sub UserForm_Initialize()
    Dim lLast As Long
    Dim rng As Range
    
    lLast = Sheet1.Range(”A” & Cells.Rows.Count).End(xlUp).Row
    varData = Sheet1.Range(”A1:A” & lLast)
    
    Me.lbxData.List = varData
End Sub
我们可以将UserForm_Initialize代码块中的代码Me.lbxData.List = varData删除，这样当在文本框txtFind中输入时，只要输入的数据符合列表框包含的数据，列表框中将自动出现相关条目并随着输入的进一步具体条目相应减少至完全匹配输入的数据，如图3、4、5所示。

图3：初始化后的用户窗体

图4：开始输入后，列表框中的条目随着文本框中输入的数据而变化

图5：文本框中的数据越具体，列表框中的条目也越少且与文本框输入相匹配
此外，在Excel 2000及以后的版本中，VBA提供了一个Filter函数，使用该函数，也能实现上述效果。代码如下：
Option Explicit
Private Sub txtFind_Change()
    Dim varData As Variant
    
    varData = Range(”A1″, Cells(Rows.Count, 1).End(xlUp)).Value
    varData = Application.Transpose(varData)
    
    varData = Filter(SourceArray:=varData, _
                   Match:=txtFind.Value, _
                   Include:=True, _
                   Compare:=vbTextCompare)
    
    Me.lbxData.List = varData

    Me.lbxData.List = Range(”A1″, Cells(Rows.Count, 1).End(xlUp)).Value
End Sub

要使用VBA从控件工具箱（ActiveX控件）中添加控件，可以使用OLEObjects集合的Add方法。该方法包含有大量的参数，包括ClassType、Top、Left、Width和Height等。其中，ClassType参数代表的一些常见的ActiveX控件的名称如下：
Forms.Checkbox.1（复选框）
Forms.Combobox.1（组合框）
Forms.Optionbutton.1（选项按钮）
Forms.Textbox.1（文本框）
Forms.Listbox.1（列表框）
Forms.Commandbutton.1（命令按钮）
下面举一个例子，提供一些思路，并供探讨。如下图所示，要求在每项工作前面都添加复选框，并且当用户选中复选框后，自动隐藏该复选框所在的行。

下面的代码用来添加复选框：
Sub RefreshList()
    Dim oCheck As OLEObject
    Dim rCell As Range, rRange As Range
    Dim lLastRow As Long
    
    
    ‘清除已经存在于工作表中的复选框
    For Each oCheck In Sheet1.OLEObjects
        oCheck.Delete
    Next oCheck
    
    lLastRow = Sheet1.Range(”B” & Cells.Rows.Count).End(xlUp).Row
    Set rRange = Sheet1.Range(”B2:B” & lLastRow)
    
    For Each rCell In rRange
        rCell.RowHeight = 14
        With Sheet1.OLEObjects.Add(ClassType:=”Forms.Checkbox.1″, _
                   Top:=rCell.Top, Left:=rCell.Offset(0, -1).Left, _
                   Height:=rCell.Height, Width:=rCell.Offset(0, -1).Width)
                      
            .Object.Caption = “”
            .LinkedCell = rCell.Offset(0, -1).Address
            .Object.Value = False
        End With
     Next rCell
    
End Sub
上述代码首先删除工作表中所有已存在的复选框，因为本示例已知道工作表中无其他控件，所以直接删除，如果无法判断是否有其他控件而只需删除复选框，可以加上一个条件判断语句：
If TypeName(oCheck.Object)=”CheckBox” Then
这样，仅删除复选框。
然后，在确定数据范围后，在第一列添加复选框并设置了一些属性值以方便以后操作。这里，有一些通用的适合于其他控件的属性，也有一些专属于复选框的属性。
下面的代码用于隐藏复选框选中后的行：
Sub HideRows()
    Dim rCell As Range, rRange As Range
    Dim lLastRow As Long
    
    lLastRow = Sheet1.Range(”B” & Cells.Rows.Count).End(xlUp).Row
    Set rRange = Sheet1.Range(”B2:B” & lLastRow)
    
    For Each rCell In rRange
        If rCell.Offset(0, -1).Value Then
            rCell.EntireRow.Hidden = True
        End If
    Next rCell
    
End Sub

上述代码遍历设定区域的每行并隐藏已复选的行。

在《链接用户窗体与工作表》及《链接用户窗体与工作表（续）》中曾介绍了在用户窗体中显示工作表中的数据的方法。这里，介绍另一种情况，即在用户窗体中查看满足特定条件的记录。如下图所示，表中姓名为张三的共三条记录，在姓名右侧文本框输入后，自动显示第1条记录，可以单击前一条和后一条按钮来回显示记录。

首先使用Find方法建立想要显示的记录区域，然后使用Property Set语句创建的自定义属性将记录区域传递给用户窗体。要确保记录区域的引用与工作表中出现的顺序相同，在Find方法中使用了After参数并将其值设置为搜索区域的最后一个单元格，这样Find方法将从单元格区域的第一个单元格开始搜索。
将用户窗体命名为UPos，其中的一些控件及其名称为：姓名文本框（txtName）、工作内容文本框（txtWork）、共有记录的文本框（txtY）、第几条记录的文本框（txtX）、前一条按钮（cmdPrev）、后一条按钮（cmdNext）。
在标准模块中输入下列代码：
Sub ShowPos()
Dim ufPos As UPos ‘用户窗体变量
Dim rFound As Range ‘存储当前找到的单元格
Dim rNameRange As Range ‘要搜索的单元格区域
Dim sFirstAdd As String ‘第一个被找到的单元格的地址
Dim rAllFound As Range ‘所有找到的单元格

‘从用户处获取数据,这里为了介绍方便采用了硬编码
Const strName As String = “张三”

Set rNameRange = Sheet1.Range(”A2:A8″)

‘查找
Set rFound = rNameRange.Find(strName, rNameRange(rNameRange.Cells.Count), xlValues, xlWhole)

‘如果找到
If Not rFound Is Nothing Then
‘存储第一个找到的单元格的地址
sFirstAdd = rFound.Address
‘添加找到的单元格到所有找到的单元格区域中
Set rAllFound = rFound
‘继续查找直到循环到开始处为止
Do
Set rFound = rNameRange.FindNext(rFound)
If rFound.Address <> sFirstAdd Then
Set rAllFound = Union(rAllFound, rFound)
End If
Loop Until rFound.Address = sFirstAdd

‘创建用户窗体
Set ufPos = New UPos

‘传递单元格区域到用户窗体
Set ufPos.AllFound = rAllFound

ufPos.Initialize
ufPos.Show
Else
MsgBox “没有找到匹配的数据!”
End If

Set ufPos = Nothing

End Sub

在用户窗体模块中，声明一些模块级的变量来包含传递的区域以及当前显示的区域。
Private mrAllFound As Range
Private mrCurrent As Range

Property Set AllFound(RHS As Range)
Set mrAllFound = RHS
End Property

在显示用户窗体之前，要初始化该窗体，将查找到的第一条记录填充窗体中的相应控件。
Public Sub Initialize()
‘设置当前记录为第一条记录
If Not mrAllFound Is Nothing Then
Set mrCurrent = mrAllFound(1)
Me.txtName.Text = mrCurrent.Value
Me.txtWork.Text = mrCurrent.Next.Value
Me.txtY.Text = mrAllFound.Cells.Count
Me.txtX.Text = 1
End If
End Sub
前一条按钮和后一条按钮使用FindPrevious方法和FindNext方法将记录移动到合适的位置。
Private Sub cmdNext_Click()
‘设置当前单元格
Set mrCurrent = mrAllFound.FindNext(mrCurrent)

Me.txtName.Text = mrCurrent.Value
Me.txtWork.Text = mrCurrent.Next.Value

‘增加计数器值
Me.txtX.Text = Me.txtX.Text + 1
End Sub

Private Sub cmdPrev_Click()
Set mrCurrent = mrAllFound.FindPrevious(mrCurrent)
Me.txtName.Text = mrCurrent.Value
Me.txtWork.Text = mrCurrent.Next.Value
Me.txtX.Text = Me.txtX.Text - 1
End Sub
最后，当第几条文本框中的值变化时，启用或禁用按钮以便使得用户不能试图到达不存在的记录。
Private Sub txtX_Change()
‘启用/禁用按钮
If Me.txtX.Text = 1 Then
Me.cmdPrev.Enabled = False
Else
Me.cmdPrev.Enabled = True
End If

If Me.txtX.Text = Me.txtY.Text Then
Me.cmdNext.Enabled = False
Else
Me.cmdNext.Enabled = True
End If
End Sub
注：本文整理自Dick的博客，稍作修改，供参考。

与VB不同，在VBA中，没有为用户窗体提供菜单生成器，因此不能简单地在用户窗体中创建菜单栏。下面是在Dick的博客中找到的例子，辑录于此，供以后参考。如下图所示，在用户窗体中添加菜单栏。

当然，也可以在显示时将用户窗体定位到与Excel工作表的界面相同，利用Excel的菜单栏充当用户窗体的菜单，这也是实现方法之一。
不过，VBA没有为用户窗体提供菜单生成器，我想还是设计者考虑到VBA内嵌于已有的应用程序软件中，因此无须再设计复杂的菜单栏了。
下载示例，请单击这里：UserFormMenu.xls。

本文是《链接用户窗体与工作表》一文的续篇，在阅读本文之前，请先阅读《链接用户窗体与工作表》。
现在，我们需要使该用户窗体在原有功能的基础上增加搜索功能。当选择字段并输入相应的数据后，能搜索到记录并显示在用户窗体中，如图4所示。

图4：在用户窗体中增加搜索功能
在原窗体中添加一个框架，在框架内添加组合框、文本框和命令按钮，各控件的名称和Tag属性如下：
名称（Tag属性）
frmFind()
cmbFind()
txtFind()
cmdFind(tgFind)
其中，括号内为空表明没有设置该控件的Tag属性。
为了使用户能搜索任一字段，因此添加了组合框cmbFind。用户可以首先从中选择要搜索的字段，然后在右侧的文本框中输入要搜索数据的全部或部分内容，最后当单击查找按钮后在下方显示该条记录的信息。
要填充组合框，在用户窗体的初始化事件Initialize的代码中添加下列语句：
Me.cmbFind.List = Application.Transpose(wksContacts.Range(”ColHeads”).Value)
其中，ColHeads为工作表中标题行区域的名称。此时，在将该名称区域的数据放置到组合框之前，需要将列数据转置为行数据。
接下来，确保查找按钮处于禁用状态，直到在组合框和文本框中含有相应的数据。因此，添加了两个事件过程和一个启用/禁用按钮控件的过程。代码如下：
Private Sub cmbFind_Change()
‘如果用户已选择组合框中的项目或者在文本框中输入内容
‘那么启用查找按钮
If Me.cmbFind.ListIndex > -1 And Len(Me.txtFind.Text) > 0 Then
EnableControls “tgFind”
Else
EnableControls “tgFind”, True
End If
End Sub

Private Sub txtFind_Change()
If Me.cmbFind.ListIndex > -1 And Len(Me.txtFind.Text) > 0 Then
EnableControls “tgFind”
Else
EnableControls “tgFind”, True
End If
End Sub

Private Sub EnableControls(sTag As String, _
Optional bDisable As Boolean = False)
Dim ctl As Control
For Each ctl In Me.Controls
If ctl.Tag = sTag Then
ctl.Enabled = Not bDisable
End If
Next ctl
End Sub

查找按钮cmdFind的代码如下：

Private Sub cmdFind_Click()
Dim lCol As Long
Dim rFound As Range

‘如果找到记录则改变滚动条到该记录
‘否则显示一条新记录
If Not rFound Is Nothing Then
Me.scbContact.Value = rFound.Row - 1
Else
Me.scbContact.Value = Me.scbContact.Max
End If
End Sub

至此，新增功能完成。当然，您可以按需要再添加其他功能，以丰富该窗体。