今天介紹在用戶窗體中查找工作表中滿足特定條件的所有記錄,如下圖所示,在工作表Sheet1中,姓名為“張三”的共有三條記錄,在姓名右側的文本框中輸入“張三”後,將自動顯示第1條記錄的相關內容,然後可以單擊“前一條”和“後一條”按鈕來回顯示相關的記錄。
首先,使用Find方法根據查找條件查找到滿足條件的所有記錄,並將其賦值給Range變量。接著,使用Property Set語句創建的自定義屬性將Range變量存儲的記錄區域傳遞給用戶窗體。為了確保引用的記錄區域與工作表中出現的順序相同,在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