マクロあれこれ

test.vba

Sub FindStrCol(Day2 As String)
    MsgBox "Day2=" & Day2 & VarType(Day2)

Dim txt As String
    txt = Day2

Dim lngYLine As Long
    Dim intXLine As Integer
    Dim Obj As Object

'        With Workbooks("Book2.xlsm").Worksheets("sheet1")
    Set Obj = Workbooks("Book2.xlsm").Worksheets("Sheet1").Cells.Find(What:="Day2", LookAt:=xlWhole, SearchOrder:=xlByRows)



    If Obj Is Nothing Then
        MsgBox Day2 & "は見つかりませんでした。"
    Else
        lngYLine = Worksheets("Sheet1").Cells.Find("診察", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows).Row
        intXLine = Worksheets("Sheet1").Cells.Find("診察", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows).Column
        MsgBox Day2 & "は、" + CStr(lngYLine) + "行目の" _
                + CStr(intXLine) + "列目にあります"
    End If

'        End With

End Sub



Private Sub FindExaminatin(x As Integer)
    With Workbooks("Book2.xlsm").Worksheets("sheet1")
        Dim i As Long
        Dim j As Long
        j = 1

        With Sheet1.UsedRange
            MaxRow = .Rows.Count
            MaxCol = .Columns.Count
        End With

            For i = 1 To MaxRow
                If .Cells(i, x).Value = "診察" Then
                    Sheet2.Cells(j + 1, 1) = .Cells(i, 1).Value
                    MsgBox "診察の文字列が" & i & "列に見つかりました。"
                    j = j + 1
                End If
            Next i
    End With
End Sub




Private Sub FindDate(a As String)
    Dim x As Integer

    With Workbooks("Book2.xlsm").Worksheets("Sheet1")
        Dim i As Long

        With Sheet1.UsedRange
            MaxRow = .Rows.Count
            MaxCol = .Columns.Count
        End With

        For x = 1 To MaxCol
            If .Cells(1, x).Value = a Then
                FindExaminatin (x)
                MsgBox a & "が" & x & " 列に見つかりました。"
        Exit For
            End If
        Next
    End With
End Sub



Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Target2 As String


    If Intersect(Target, Range("E1:E1")) Is Nothing Then
        Exit Sub
    Else
        If IsDate(Target) Then
            Range("A2:A65535").Clear
            Target2 = CStr(Target)
            MsgBox Target2 & "を検索します"
        Else
            MsgBox Target & "E1の入力値が日付の形式ではありません"
            Exit Sub
        End If
    End If
    Call FindDate(Target2)
    Call FindStrCol(Target2)
End Sub