[172.xls]



' [mjSumple] のコード
'■■ 検索条件に合致したセルの値を別のシートに追記する ■■
'
'
Const strSrhSheet = "Title"
Const strDataSheet = "Data"

Dim intEndRow As Integer
Dim intSetRow As Integer

Dim strSrhCode As String
Dim strDate As String
Dim strCode As String
Dim strName As String

Sub psDataCheck()
    
    strSrhCode = Sheets(strSrhSheet).Range("F9")
    
    For intCnt = 9 To 13
        If strSrhCode = Worksheets(strSrhSheet).Cells(intCnt, 9) Then
            
            strDate = Worksheets(strSrhSheet).Cells(intCnt, 8)
            strCode = Worksheets(strSrhSheet).Cells(intCnt, 9)
            strName = Worksheets(strSrhSheet).Cells(intCnt, 10)
            
            intSetRow = Sheets(strDataSheet).Range("A1").CurrentRegion.Rows.Count + 1
            
            Worksheets(strDataSheet).Cells(intSetRow, 1) = strDate
            Worksheets(strDataSheet).Cells(intSetRow, 2) = strCode
            Worksheets(strDataSheet).Cells(intSetRow, 3) = strName
            
        End If
    Next intCnt
    
End Sub