Option Explicit
 
Public Sub 検索結果クリア()
    Dim sh As Worksheet
    Dim maxrow As Long
    Set sh = Worksheets("検索結果")
    maxrow = sh.Cells(Rows.Count, 1).End(xlUp).Row    'A列の最大行取得
    If maxrow < 3 Then Exit Sub
    sh.Range("A3:F" & maxrow).ClearContents
    MsgBox ("クリア完了")
End Sub
 
 
Public Sub 検索実行()
    Dim sh As Worksheet
    Dim ws As Worksheet
    Dim maxrow1 As Long         '検索対象シート最大行
    Dim maxrow2 As Long         '検索結果シート最大行
    Dim wrow As Long
    Dim frow As Long            '検索した文字列のある商品の1行目の行番号
    Dim krow As Long            '検索結果シートの行番号
    Dim sheet_name As String    '検索対象シート名
    Dim find_str As String      '検索対象文字列
    Dim result As Long
    Set sh = Worksheets("検索結果")
    sheet_name = sh.Range("H2").Value
    If sheet_name = "" Then
        MsgBox ("検索シート名未設定")
        Exit Sub
    End If
    find_str = sh.Range("I2").Value
    If find_str = "" Then
        MsgBox ("検索文字未設定")
        Exit Sub
    End If
    If isExistSheet(sheet_name) = False Then Exit Sub
    Set ws = Worksheets(sheet_name)
    maxrow1 = ws.Cells(Rows.Count, 1).End(xlUp).Row    '検索対象シート　A列の最大行取得
    maxrow2 = sh.Cells(Rows.Count, 1).End(xlUp).Row    '検索結果シート　A列の最大行取得
    frow = 0
    For wrow = 3 To maxrow1
        '該当文字が存在すれば、設定を行う
        If InStr(1, ws.Cells(wrow, "A").Value, find_str, vbTextCompare) > 0 Then
            If ws.Cells(wrow, "C").Value <> "" And ws.Cells(wrow, "F").Value <> "" Then
                frow = wrow - 1
            ElseIf ws.Cells(wrow + 1, "C").Value <> "" And ws.Cells(wrow + 1, "F").Value <> "" Then
                frow = wrow
            ElseIf ws.Cells(wrow - 1, "C").Value <> "" And ws.Cells(wrow - 1, "F").Value <> "" Then
                frow = wrow - 2
            Else
                frow = 1
            End If
            Exit For
        End If
    Next
    If frow = 0 Then
        MsgBox ("該当文字列なし")
        Exit Sub
    End If
    If frow = 1 Then
        ws.Activate
        ws.Cells(wrow, "A").Select
        MsgBox ("該当文字はあるが、数量、金額なし")
        Exit Sub
    End If
    sh.Range("A" & maxrow2 + 1 & ":F" & maxrow2 + 3).Value = ws.Range("A" & frow & ":F" & frow + 2).Value
    MsgBox ("検索完了")
End Sub
'シートの存在チェック
Private Function isExistSheet(ByVal sheet_name As String) As Boolean
    isExistSheet = False
    On Error GoTo ERROR99
    Dim ws As Worksheet
    Set ws = Worksheets(sheet_name)
    isExistSheet = True
    Exit Function
ERROR99:
    MsgBox (sheet_name & "は存在しません")
End Function
 

T3B0aW9uIEV4cGxpY2l0CgpQdWJsaWMgU3ViIOaknOe0oue1kOaenOOCr+ODquOCoigpCiAgICBEaW0gc2ggQXMgV29ya3NoZWV0CiAgICBEaW0gbWF4cm93IEFzIExvbmcKICAgIFNldCBzaCA9IFdvcmtzaGVldHMoIuaknOe0oue1kOaenCIpCiAgICBtYXhyb3cgPSBzaC5DZWxscyhSb3dzLkNvdW50LCAxKS5FbmQoeGxVcCkuUm93ICAgICdB5YiX44Gu5pyA5aSn6KGM5Y+W5b6XCiAgICBJZiBtYXhyb3cgPCAzIFRoZW4gRXhpdCBTdWIKICAgIHNoLlJhbmdlKCJBMzpGIiAmIG1heHJvdykuQ2xlYXJDb250ZW50cwogICAgTXNnQm94ICgi44Kv44Oq44Ki5a6M5LqGIikKRW5kIFN1YgoKClB1YmxpYyBTdWIg5qSc57Si5a6f6KGMKCkKICAgIERpbSBzaCBBcyBXb3Jrc2hlZXQKICAgIERpbSB3cyBBcyBXb3Jrc2hlZXQKICAgIERpbSBtYXhyb3cxIEFzIExvbmcgICAgICAgICAn5qSc57Si5a++6LGh44K344O844OI5pyA5aSn6KGMCiAgICBEaW0gbWF4cm93MiBBcyBMb25nICAgICAgICAgJ+aknOe0oue1kOaenOOCt+ODvOODiOacgOWkp+ihjAogICAgRGltIHdyb3cgQXMgTG9uZwogICAgRGltIGZyb3cgQXMgTG9uZyAgICAgICAgICAgICfmpJzntKLjgZfjgZ/mloflrZfliJfjga7jgYLjgovllYblk4Hjga4x6KGM55uu44Gu6KGM55Wq5Y+3CiAgICBEaW0ga3JvdyBBcyBMb25nICAgICAgICAgICAgJ+aknOe0oue1kOaenOOCt+ODvOODiOOBruihjOeVquWPtwogICAgRGltIHNoZWV0X25hbWUgQXMgU3RyaW5nICAgICfmpJzntKLlr77osaHjgrfjg7zjg4jlkI0KICAgIERpbSBmaW5kX3N0ciBBcyBTdHJpbmcgICAgICAn5qSc57Si5a++6LGh5paH5a2X5YiXCiAgICBEaW0gcmVzdWx0IEFzIExvbmcKICAgIFNldCBzaCA9IFdvcmtzaGVldHMoIuaknOe0oue1kOaenCIpCiAgICBzaGVldF9uYW1lID0gc2guUmFuZ2UoIkgyIikuVmFsdWUKICAgIElmIHNoZWV0X25hbWUgPSAiIiBUaGVuCiAgICAgICAgTXNnQm94ICgi5qSc57Si44K344O844OI5ZCN5pyq6Kit5a6aIikKICAgICAgICBFeGl0IFN1YgogICAgRW5kIElmCiAgICBmaW5kX3N0ciA9IHNoLlJhbmdlKCJJMiIpLlZhbHVlCiAgICBJZiBmaW5kX3N0ciA9ICIiIFRoZW4KICAgICAgICBNc2dCb3ggKCLmpJzntKLmloflrZfmnKroqK3lrpoiKQogICAgICAgIEV4aXQgU3ViCiAgICBFbmQgSWYKICAgIElmIGlzRXhpc3RTaGVldChzaGVldF9uYW1lKSA9IEZhbHNlIFRoZW4gRXhpdCBTdWIKICAgIFNldCB3cyA9IFdvcmtzaGVldHMoc2hlZXRfbmFtZSkKICAgIG1heHJvdzEgPSB3cy5DZWxscyhSb3dzLkNvdW50LCAxKS5FbmQoeGxVcCkuUm93ICAgICfmpJzntKLlr77osaHjgrfjg7zjg4jjgIBB5YiX44Gu5pyA5aSn6KGM5Y+W5b6XCiAgICBtYXhyb3cyID0gc2guQ2VsbHMoUm93cy5Db3VudCwgMSkuRW5kKHhsVXApLlJvdyAgICAn5qSc57Si57WQ5p6c44K344O844OI44CAQeWIl+OBruacgOWkp+ihjOWPluW+lwogICAgZnJvdyA9IDAKICAgIEZvciB3cm93ID0gMyBUbyBtYXhyb3cxCiAgICAgICAgJ+ipsuW9k+aWh+Wtl+OBjOWtmOWcqOOBmeOCjOOBsOOAgeioreWumuOCkuihjOOBhgogICAgICAgIElmIEluU3RyKDEsIHdzLkNlbGxzKHdyb3csICJBIikuVmFsdWUsIGZpbmRfc3RyLCB2YlRleHRDb21wYXJlKSA+IDAgVGhlbgogICAgICAgICAgICBJZiB3cy5DZWxscyh3cm93LCAiQyIpLlZhbHVlIDw+ICIiIEFuZCB3cy5DZWxscyh3cm93LCAiRiIpLlZhbHVlIDw+ICIiIFRoZW4KICAgICAgICAgICAgICAgIGZyb3cgPSB3cm93IC0gMQogICAgICAgICAgICBFbHNlSWYgd3MuQ2VsbHMod3JvdyArIDEsICJDIikuVmFsdWUgPD4gIiIgQW5kIHdzLkNlbGxzKHdyb3cgKyAxLCAiRiIpLlZhbHVlIDw+ICIiIFRoZW4KICAgICAgICAgICAgICAgIGZyb3cgPSB3cm93CiAgICAgICAgICAgIEVsc2VJZiB3cy5DZWxscyh3cm93IC0gMSwgIkMiKS5WYWx1ZSA8PiAiIiBBbmQgd3MuQ2VsbHMod3JvdyAtIDEsICJGIikuVmFsdWUgPD4gIiIgVGhlbgogICAgICAgICAgICAgICAgZnJvdyA9IHdyb3cgLSAyCiAgICAgICAgICAgIEVsc2UKICAgICAgICAgICAgICAgIGZyb3cgPSAxCiAgICAgICAgICAgIEVuZCBJZgogICAgICAgICAgICBFeGl0IEZvcgogICAgICAgIEVuZCBJZgogICAgTmV4dAogICAgSWYgZnJvdyA9IDAgVGhlbgogICAgICAgIE1zZ0JveCAoIuipsuW9k+aWh+Wtl+WIl+OBquOBlyIpCiAgICAgICAgRXhpdCBTdWIKICAgIEVuZCBJZgogICAgSWYgZnJvdyA9IDEgVGhlbgogICAgICAgIHdzLkFjdGl2YXRlCiAgICAgICAgd3MuQ2VsbHMod3JvdywgIkEiKS5TZWxlY3QKICAgICAgICBNc2dCb3ggKCLoqbLlvZPmloflrZfjga/jgYLjgovjgYzjgIHmlbDph4/jgIHph5HpoY3jgarjgZciKQogICAgICAgIEV4aXQgU3ViCiAgICBFbmQgSWYKICAgIHNoLlJhbmdlKCJBIiAmIG1heHJvdzIgKyAxICYgIjpGIiAmIG1heHJvdzIgKyAzKS5WYWx1ZSA9IHdzLlJhbmdlKCJBIiAmIGZyb3cgJiAiOkYiICYgZnJvdyArIDIpLlZhbHVlCiAgICBNc2dCb3ggKCLmpJzntKLlrozkuoYiKQpFbmQgU3ViCifjgrfjg7zjg4jjga7lrZjlnKjjg4Hjgqfjg4Pjgq8KUHJpdmF0ZSBGdW5jdGlvbiBpc0V4aXN0U2hlZXQoQnlWYWwgc2hlZXRfbmFtZSBBcyBTdHJpbmcpIEFzIEJvb2xlYW4KICAgIGlzRXhpc3RTaGVldCA9IEZhbHNlCiAgICBPbiBFcnJvciBHb1RvIEVSUk9SOTkKICAgIERpbSB3cyBBcyBXb3Jrc2hlZXQKICAgIFNldCB3cyA9IFdvcmtzaGVldHMoc2hlZXRfbmFtZSkKICAgIGlzRXhpc3RTaGVldCA9IFRydWUKICAgIEV4aXQgRnVuY3Rpb24KRVJST1I5OToKICAgIE1zZ0JveCAoc2hlZXRfbmFtZSAmICLjga/lrZjlnKjjgZfjgb7jgZvjgpMiKQpFbmQgRnVuY3Rpb24K