| |
日付をFindで探すのは色々難しい見たい？
こんなのでは？
Sub 抽出_2()
Dim lngYLine As Long
Dim intXLine As Long
' Dim Obj As Object
' Dim day As Integer
' Dim ws As String
Dim i As Long
Dim vntDay As Variant
Dim vntDate() As Variant
Dim wksList As Worksheet
Dim ws As Worksheet
Set wksList = ActiveWorkbook.Worksheets("シフト")
vntDay = Range("F4").Value
Set ws = ActiveSheet
' Set Obj = Worksheets("シフト").Cells.Find(day, LookAt:=xlWhole)
' If Obj Is Nothing Then
' MsgBox "対象の日付が見つかりませんでした。"
' Else
' lngYLine = Worksheets("シフト").Cells.Find(day).Row
' intXLine = Worksheets("シフト").Cells.Find(day).Column
' End If
'日付の行を配列として取得
vntDate = wksList.Range("E3:AI3").Value
'日付行を先頭から見て行く
For i = 1 To UBound(vntDate, 2)
'もし、Range("F4")と同じ日付が有ったらForを抜ける
If vntDate(1, i) = vntDay Then
Exit For
End If
Next i
'日付が有った場合
If i <= UBound(vntDate, 2) Then
'行位置は固定
lngYLine = 3
'E列（5列目）からの列位置を取得
intXLine = 5 + i - 1
Else
MsgBox "対象の日付が見つかりませんでした。"
End If
With wksList
For i = 6 To 38
If Not (.Cells(i, intXLine).Value = "" _
Or .Cells(i, intXLine).Value = "休" _
Or .Cells(i, intXLine).Value = "有 ") Then
If .Cells(i, 2).Value <> "" Then
ws.Range("B9").Value _
= ws.Range("B9").Value & .Cells(i, 2).Value & "、"
End If
End If
Next i
End With
ws.Activate
Set wksList = Nothing
Set ws = Nothing
End Sub
|
|
Hirofumi
- 10/11/24(水) 9:12 -
