Dim sname As String
Dim ms1 As String
Dim ms3 As String
Dim kom As Integer  '検索する項目
Dim sck As Integer  'シ−トがあるかチェック
Dim har As Integer  '貼り付け方法
Dim ccc As Integer  '抽出数
Dim dat             '検索するデ−タ
Sub ki171()
Sheets("Sheet1").Select
ki171a
End Sub


Sub ki171a()
 Application.ScreenUpdating = False
 sname = ActiveSheet.Name

 '  オ−トフィルタ−解除
'     Application.Worksheets(sname).Activate
'     ActiveSheet.AutoFilterMode = False
     
     UserForm1.Show
End Sub

Sub 検索()
' ダイアログのデ−タ入力
      dat = UserForm1.txt1.Text
    
      If UserForm1.opt1.Value = True Then
         kom = 1: ms1$ = "項目"
      ElseIf UserForm1.opt2.Value = True Then
         kom = 2: ms1$ = "品名"
      ElseIf UserForm1.opt3.Value = True Then
         kom = 3: ms1$ = "数量"
      ElseIf UserForm1.opt5.Value = True Then
         kom = 4: ms1$ = "配膳"
      ElseIf UserForm1.opt5.Value = True Then
         kom = 5: ms1$ = "組立"
      ElseIf UserForm1.opt6.Value = True Then
         kom = 6: ms1$ = "点検"
      Else
         MsgBox "検索するアイテムを指定して下さい"
         Exit Sub
      End If
'
'データ２個検索
     op = 0: data = 0: datb = 0
    data = InStr(1, dat, " or", 1)
    datb = InStr(1, dat, " and", 1)
    If data > 1 Then
       op = 1
       dat1 = Trim(Mid(dat, 1, data - 1))
       dat2 = Trim(Mid(dat, data + 3))
    End If
    If datb > 1 Then
       op = 2
       dat1 = Trim(Mid(dat, 1, datb - 1))
       dat2 = Trim(Mid(dat, datb + 4))
    End If
    UserForm1.Hide
'
'デ−タ検索
      Application.Worksheets(sname).Activate
      Range("a1").Select
    If op = 1 Then
      Selection.AutoFilter Field:=kom, Criteria1:=dat1, _
      Operator:=xlOr, Criteria2:=dat2
    ElseIf op = 2 Then
      Selection.AutoFilter Field:=kom, Criteria1:=dat1, _
      Operator:=xlAnd, Criteria2:=dat2
    Else
      Selection.AutoFilter Field:=kom, Criteria1:=dat
    End If
'
  If ActiveSheet.Buttons.Count = 1 Then
    ActiveSheet.Buttons.Select
        nam = Selection.Name
    ActiveSheet.Buttons(nam).Select
        Selection.Delete
  End If
    
    ActiveSheet.Buttons.Add(340.5, 1.5, 31.5, 14.25).Select
        Selection.OnAction = "解除"
        Selection.Characters.Text = "解除"
    Range("A1").Select
    検出結果
End Sub
Sub 検出結果()
 Application.ScreenUpdating = True
      ms3$ = ""
      ms2$ = "を検索しました。" & Chr$(10) & _
           "この結果を｢検索結果｣シ−トへコピ−しますか？"
      ta = MsgBox("[" & ms1 & "]" & "の ｢" & dat & "｣ " & ms2$, 3, "検索結果")
 Application.ScreenUpdating = False
      If ta = 2 Then
         Exit Sub
      ElseIf ta = 7 Then       '  オ−トフィルタ−解除
        ActiveSheet.AutoFilterMode = False
        ActiveSheet.Buttons.Select
            nam = Selection.Name
        ActiveSheet.Buttons(nam).Select
            Selection.Delete
        ActiveSheet.Buttons.Add(340.5, 1.5, 31.5, 14.25).Select
            Selection.OnAction = "ki171a"
            Selection.Characters.Text = "検索"
            Range("A1").Select
            Exit Sub
      Else
         コピイ
      End If
End Sub
Sub コピイ()
'シ−トの有無チェック
        sck = 0
    For Each sheet_name In Worksheets
        If sheet_name.Name = ("検索結果") Then
           sck = 1
           Exit For
        End If
    Next
' シートの追加
    If sck = 0 Then
       Sheets.Add.Name = "検索結果"
    End If
      ms2$ = "前回検索の下へ追加しますか。"
      tb = MsgBox(ms2$, 4, "検索結果の表示")
If tb = 7 Then
    If sck = 1 Then
        Application.DisplayAlerts = False
            Sheets("検索結果").Delete
        Application.DisplayAlerts = True
           Sheets.Add.Name = "検索結果"
            Range("A1").Select
    End If
    cen3 = 1
Else
   Sheets("検索結果").Select
   Selection.SpecialCells(xlCellTypeLastCell).Select
   cen3 = ActiveCell.Row
End If
' セル数のチェック
   Sheets(sname).Select
   ccc = 0
   Range("a1").CurrentRegion.SpecialCells(xlCellTypeVisible).Select
   For Each sel In Selection.Areas
        ccc = ccc + sel.Rows.Count
   Next sel
   ms3 = "-----　" & ccc - 1 & "個抽出"
      
   If ccc = 1 Then
       Sheets("検索結果").Select
      ms3 = "--------- ＤＡＴＡ無し"
      最終処理
      Exit Sub
   End If
' コピ−
     Range("A1").CurrentRegion.Copy
' 貼り付け
        Sheets("検索結果").Select
         Application.Cells(cen3 + 1, 1).Select
        ActiveSheet.Paste
     '
         最終処理
       Exit Sub
End Sub
Sub 最終処理()
      Range("a1").Select
          Selection.CurrentRegion.Select
          cen4 = Selection.Rows.Count
          Range("a1").Select
          Cells(cen4 + 1, 1) = "[" & ms1$ & "]" & "--- ｢" & dat & "｣ " & "の検索結果" & ms3
          Cells(cen4 + 2, 1) = "."
    
     ' オ−トフィルタ−解除
        Application.Worksheets(sname).Activate
        ActiveSheet.AutoFilterMode = False
        ActiveSheet.Buttons.Select
            nam = Selection.Name
        ActiveSheet.Buttons(nam).Select
            Selection.Delete
        ActiveSheet.Buttons.Add(340.5, 1.5, 31.5, 14.25).Select
            Selection.OnAction = "ki171a"
            Selection.Characters.Text = "検索"
            Range("A1").Select
        
        Application.CutCopyMode = fales
        Application.Worksheets("検索結果").Activate
        Range("A1").Select
End Sub
'

Sub 解除()
 '  オ−トフィルタ−解除
     Application.Worksheets(sname).Activate
       ActiveSheet.AutoFilterMode = False
       ActiveSheet.Buttons.Select
       nam = Selection.Name
       
       ActiveSheet.Buttons(nam).Select
        Selection.Delete
      ActiveSheet.Buttons.Add(340.5, 1.5, 31.5, 14.25).Select
    Selection.Characters.Text = "検索"
    Selection.OnAction = "ki171a"
    Range("A1").Select
End Sub