1、首先,使用Find方法根据查找条件查找到满足条件的所有记录,并将其赋值给Range变量。接着,使用Property Set语句创建的自定义属性将Range变量存储的记录区域传递给用户窗体。为了确保引用的记录区域与工作表中出现的顺序相同,在Find方法中使用了After参数并将其值设置为搜索区域的最后一个单元格,这样Find方法将从单元格区域的第一个单元格开始搜索。将用户窗体命名为UPos,其中的一些控件及其名称为:姓名文本框(txtName)、工作内容文本框(txtWork)、共有记录的文本框(txtY)、第几条记录的文本框(txtX)、前一条按钮(cmdPrev)、后一条按钮(cmdNext),还有一些标签控件。
2、在标准模块中输入下列代码: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'继续查找直到循环到开始处为止DoSet rFound = rNameRange.FindNext(rFound)If rFound.Address <> sFirstAdd ThenSet rAllFound = Union(rAllFound, rFound)End IfLoop Until rFound.Address = sFirstAdd'创建用户窗体Set ufPos = New UPos'传递单元格区域到用户窗体Set ufPos.AllFound = rAllFoundufPos.InitializeufPos.ShowElseMsgBox "没有找到匹配的数据!"End IfSet ufPos = NothingEnd Sub
3、在用户窗体模块中,声明一些模块级的变量来包含传递的区域以及当前显示的区域。 Private mrAllFound As RangePrivate mrCurrent As RangeProperty Set AllFound(RHS As Range)Set mrAllFound = RHSEnd Property
4、在显示用户窗体之前,要初始化该窗体,使用查找到的第一条记录填充窗体中的相应控件。 Public Sub Initialize()'设置当前记录为第一条记录If Not mrAllFound Is Nothing ThenSet mrCurrent = mrAllFound(1)Me.txtName.Text = mrCurrent.ValueMe.txtWork.Text = mrCurrent.Next.ValueMe.txtY.Text = mrAllFound.Cells.CountMe.txtX.Text = 1End IfEnd Sub
5、前一条按钮和后一条按钮使用FindPrevious方法和FindNext方法将记录移动到合适的位置。 Pr足毂忍珩ivate Sub cmdNext_Click()'设置当前单元格Set mrCurrent = mrAllFound.FindNext(mrCurrent)Me.txtName.Text = mrCurrent.ValueMe.txtWork.Text = mrCurrent.Next.Value'增加计数器值Me.txtX.Text = Me.txtX.Text + 1End SubPrivate Sub cmdPrev_Click()Set mrCurrent = mrAllFound.FindPrevious(mrCurrent)Me.txtName.Text = mrCurrent.ValueMe.txtWork.Text = mrCurrent.Next.ValueMe.txtX.Text = Me.txtX.Text - 1End Sub
6、最后,当第几条文本框中的值变化时,启用或禁用按钮使得用户不能试图到达不存在的记录。 Private Sub txtX_Change()'启用/禁用按钮If Me.txtX.Text = 1 ThenMe.cmdPrev.Enabled = FalseElseMe.cmdPrev.Enabled = TrueEnd IfIf Me.txtX.Text = Me.txtY.Text ThenMe.cmdNext.Enabled = FalseElseMe.cmdNext.Enabled = TrueEnd IfEnd Sub