Sub 検索1_1()
Dim ccc As Integer, sel As Object
    Range("A2").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=2, Criteria1:="D"
    Range("A2").Select
    endr = Range("B10000").End(xlUp).Row
 
    Range(Cells(3, 3), Cells(endr, 3)).SpecialCells(xlVisible).Select
 
    For Each sel In Selection
        ccc = ccc + sel.Value
    Next
MsgBox ccc
Selection.AutoFilter
End Sub

Sub 検索1_2()
Dim ban As Integer, sel As Object
    Range("A2").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=2, Criteria1:="F"
    Range("A2").Select
    Range("A2").Select
    endr = Range("B10000").End(xlUp).Row
 
    Range(Cells(3, 3), Cells(endr, 3)).SpecialCells(xlVisible).Select
    ban = 1
    For Each sel In Selection
        sel.Select
        r = ActiveCell.Row
            Cells(r, 4) = ban
            ban = ban + 1
    Next
End Sub

Sub 検索1_4()
Dim ccc As Integer
    ccc = WorksheetFunction.Subtotal(9, Range("C:C"))
    MsgBox "検索した「D]の合計は⇒ " & ccc
End Sub

Sub 検索1_5()
Dim ccc As Integer
    ccc = WorksheetFunction.Subtotal(3, Range("C:C")) - 1
    MsgBox "抽出した行数は⇒ " & ccc
End Sub

Sub 検索1_3()
Dim ccc As Integer, sel1 As Object, sel2 As Object
    endr = Range("B10000").End(xlUp).Row
    Set sel1 = Range(Cells(3, 2), Cells(endr, 2))
    Set sel2 = Range(Cells(3, 3), Cells(endr, 3))
 
    ccc = Application.WorksheetFunction.SumIf(sel1, "D", sel2)
 
   MsgBox "検索した「D]の合計は⇒ " & ccc
End Sub

Sub 検索1_3()
Dim myrng As Range, mozi As String, msg As String
Dim stadd As String, ync As Integer
 
mozi = InputBox("検索する文字を指定してください", "検索")
If mozi = "" Then Exit Sub
    Set myrng = Cells.Find(mozi, LookAt:=xlPart)
        If myrng Is Nothing Then
               MsgBox "検索文字はありません"
               Exit Sub
            Else
              myrng.Select
              stadd = ActiveCell.Address
        msg = "検索文字「" & mozi & "」は["
        ync = MsgBox(msg & ActiveCell.Address & "]にあります", 1, "検索結果")
              If ync = 2 Then Exit Sub
            End If
Do
     Cells.FindNext(After:=ActiveCell).Activate
        If stadd = ActiveCell.Address Then
            Exit Do
        End If
        ync = MsgBox(msg & ActiveCell.Address & "]にあります", 1, "検索結果")
              If ync = 2 Then Exit Sub
Loop
    MsgBox "検索が終了しました。"
End Sub

Sub 検索2()
Dim linname As Variant, linn As String, actv As Object
Dim i As Integer, msg As String, yn As Integer
Application.ScreenUpdating = False
ReDim chk(3, 100) As String
i = 0
    snam = ActiveSheet.Name
    Sheets(snam).Copy
Do
  linname = ActiveWorkbook.LinkSources()
  If IsEmpty(linname) Then
     Exit Do
  Else
  linn = Right(linname(1), 6)
  ActiveSheet.UsedRange.Select
  Set actv = Selection.Find(linn, , , xlPart)
        If actv Is Nothing Then
              Exit Do
        Else
            actv.Select
            chk(0, i) = snam
            chk(1, i) = linname(1)
            chk(2, i) = ActiveCell.Row
            chk(3, i) = ActiveCell.Column
            i = i + 1
       Cells(ActiveCell.Row, ActiveCell.Column).ClearContents
       End If
  End If
Loop
    ActiveWorkbook.Saved = True
    ActiveWorkbook.Close
    Application.ScreenUpdating = True
If i = 0 Then
  MsgBox "チェックしたブックにはリンクを張ったセルはありません。"
Else
  msg = "このブックにはリンクを張ったセルが「" & i & "」個あります。" & _
  Chr$(10) & "リンクを張ったセルをアクティブにしますか"
 yn = MsgBox(msg, 36, "セルの表示 ")
  If yn = 7 Then
     Exit Sub
  End If
End If
i = i - 1
For j = 0 To i
 Worksheets(chk(0, j)).Activate
    Cells(Val(chk(2, j)), Val(chk(3, j))).Select
    msg = "シ−ト名は　" & chk(0, j) & Chr(10) & _
   "リンク元は　" & chk(1, j) & Chr(10) & _
   "リンクの記述セル（" & chk(2, j) & "行、" & chk(3, j) & "列）" & _
        Chr(10) & "次を表示しますか"
   yn = MsgBox(msg, 4, "リンク場所 ")
   If yn = 7 Then
     Exit Sub
  End If
Next
  MsgBox "表示は終了しました。"
End Sub

Sub エラー1()
On Error Resume Next
    Sheets("Sheet10").Select
    If Err = 9 Then
        MsgBox "エラーが発生しました。"
    Else
        ActiveCell.FormulaR1C1 = "abc123"
    End If
On Error GoTo 0
End Sub

Sub エラー2()
On Error GoTo shoti
    Sheets("Sheet10").Select
        ActiveCell.FormulaR1C1 = "abc123"
 
 Exit Sub
shoti:
    MsgBox "エラーが発生しました。"
End Sub

Sub ふりかな()
カタカナ指定
    Range(Cells(2, 1), Cells(20, 1)).Select
    Selection.SetPhonetic
    Selection.Phonetics.CharacterType = xlKatakana
ふりがな入力
    Range(Cells(2, 2), Cells(20, 2)).Formula = "=PHONETIC(a2)"
    Range("a1").Select
End Sub