フィルタリング検索ボックスを作成します

応答4# ->にスキップ

3 #

valuesm 2015-08-20 21:12

ありがとう、OSSIEMAC.ファイルを共有する方法がわかりませんでした.これが私のファイルです 会議カレンダーの例

最小限のExcel Savvyである視聴者に優しいフィルタ検索ボックスを作成しようとしています.カレンダーの範囲は、週から週(列と行の開始点ではなく終了行)からも変更できます.

応答3# ->にスキップ

5 #

OssieMa 2015-08-21 13:091

こんにちはレニー

zipファイルを次のリンクにアップロードしました.変更が必要な場合は、確認して私に連絡してください.

機能しません.

検索条件では大文字と小文字が区別されないため、大文字または小文字のいずれかを使用できます.

これにより、ユーザーは検索用に最小限のテキストを入力でき、システムは先頭と末尾の両方のワイルドカードを自動的に追加し、フィルターをセルに設定します 入力したテキストを含む.

ユーザーはさらにワイルドカードを入力することもできるため、[会議の種類]フィールドから「SMARTLab-認定看護」を希望する場合は、「smart* nurs」(二重引用符なし)と入力するだけで、すべての「SMARTLab-認定看護」が検索されます.看護」.

ユーザーが「SMARTLab」が完全に一致するレコードのみが必要な場合は、検索条件を「smart lab」のように一重引用符で囲み、「smartlab」と完全に一致するフィールドのみを返します..

同様の問題を抱えている他の人を助けることができるように、情報の次のコード.

Sub SetFilters()
Dim shp As Shape
Dim strCaption As String
Dim rngFiltHead As Range
Dim lngFiltCol As Long
Dim strFilter As String
If Trim(Activesheet.OLEObjects( "txtSearch").Object.Value)= "" Then
Beep
MsgBox "検索値を入力してください." &vbCrLf&_
"処理が終了しました."
Exit Sub
End If
For Each shp In Activesheet.Shapes
If shp.Type=msoFormControl Then
If shp.FormControlType=xlOptionButton Then
'次の行は、オプションボタンのキャプションを変数に割り当てます
If shp.ControlFormat.Value=1 Then'選択すると1になります
strCaption=Trim(shp.TextFrame.Characters.Caption)
Exit For
End If
End If
End If
Next shp
'オプションボタンのキャプションに一致する列ヘッダーを検索します
With Activesheet.AutoFilter.Range.Cells
rngFiltHead=.Find(What:= strCaption、_
LookIn:= xlFormulas、_
LookAt:= xlPart、_
SearchOrder:= xlByColumns、_
SearchDirection:= xlNext、_
MatchCase:= False)
If Not rngFiltHead Is Nothing Then
If Activesheet.AutoFilterMode=False Then 'オートフィルターがオンになっていない場合
rngFiltHead.AutoFilter'オートフィルターをオンにします
End If
lngFiltCol=rngFiltHead.Column 'フィルターを設定するための列番号を保存します
その他
ビープ音
MsgBox "問題.オプションボタンのキャプションで示されるヘッダーが見つかりません."_
&vbCrLf&"処理が終了しました."
Exit Sub
End If
End With
strFilter=Trim(Activesheet.OLEObjects(" txtSearch ").Object.Value)
If InStr(1、strFilter、Chr(39))>0 Then '一重引用符で囲まれている場合
'フィルターを正確に検索条件に設定
strFilter ="=" &Replace(strFilter、Chr(39)、 ""、1)
Else
'次の行は、検索用に先頭と末尾のアスタリスクワイルドカードを追加します
strFilter="=*"&Activesheet.OLEObjects( "txtSearch" ).Object.Value& "*"
End If
'次の行の "AutoFilter.Range"はオートフィルターの総称範囲であるため、_
追加の行(または行)が追加されても問題ありません.削除済み)
Activesheet.AutoFilter.Range.AutoFilter Field:= lngFiltCol、Criteria1:= strFilter
If WorksheetFunction.Subtotal(3、Activesheet.AutoFilter.Range.Columns(lngFiltCol))= 1 Then
Beep
MsgBox "フィルターは何も見つかりませんでした.検索フィルターを再入力します."_
&vbCrLf&strCaption&"フィルターはクリアされます."
Activesheet.AutoFilter.Range.AutoFilter Field:= lngFiltCol '何も見つからない場合はフィルターを削除します
End If
サブの終了

Sub ClearFilters()
With Activesheet
If.AutoFilterMode Then
If.FilterMode Then
Activesheet.ShowAllData
End If
End If
End With
Activesheet.OLEObjects( "txtSearch").Object.Value=""
End Sub

応答5# ->にスキップ

2 #

valuesm 2015-08-21 23:06

OssieMac、

これはまさに私が探していたものです.ありがとうございました！将来必要になった場合に、フィールドの名前を更新する方法も考え出しました.

本当に、あなたの専門知識と共有する意欲に本当に感謝しています.

レニー

応答2# ->にスキップ

1 #

OssieMa 2015-08-22 06:35

こんにちはレニー、

返信ありがとうございます.私は実際に上記の説明を含めるつもりでしたが、投稿時に頭がおかしくなったに違いありません.ただし、サンプルコードを理解するための努力は、有能なプログラマーになるために大いに役立ちます.