|
みなさん今晩は。
私も、ちょっと作ってみたので、のせてみます。
試してみてください。
Sheet1 が元データ
Sheet1 のA列からE列のセルは、書式を文字列に設定してください。
Sheet1 のG2 H2 セルも、書式を文字列に設定してください。
Sheet1 のG2 H2 セルに開始日、最終日を入れてください。
Sheet2 に結果を出力します。
Sub test()
Dim mday As Integer
Dim strng As String
Dim Dic As Object
Dim d()
Dim 行数 As Long, j As Long
Dim r As Range, c As Range
Dim 開始日, 最終日
Const 列数 = 5 ' <--- 取得列数
'期間入力
開始日 = Split(Range("G2").Text, "/") 'G2セル開始日
最終日 = Split(Range("H2").Text, "/") 'H2セル最終日
'Dictionaryを作成
Set Dic = CreateObject("Scripting.Dictionary")
For mday = 1 To 最終日(1)
strng = 開始日(0) & "/" & mday
Dic(strng) = Empty
Next
'
'抽出処理
For Each r In Range("A1", Range("A65536").End(xlUp))
For Each c In r.Resize(1, 列数)
If Dic.Exists(c.Text) = True Then
行数 = 行数 + 1
ReDim Preserve d(1 To 行数)
d(行数) = r.Resize(1, 列数).Value
Exit For
End If
Next
Next
'
'Sheet2を準備
'書式を文字列に設定
Sheets("Sheet2").Range("A:E").Resize(, 列数).NumberFormatLocal = "@"
Sheets("Sheet2").Cells.ClearContents
'1行目をコピー貼り付け
Sheets("Sheet2").Range("A1:E1").Value _
= Sheets("Sheet1").Range("A1:E1").Value
'
'2行目から結果を貼り付け
With Application
Sheets("Sheet2").Range("A2").Resize(行数, 列数).Value _
= .Transpose(.Transpose(d))
End With
'
Set Dic = Nothing
End Sub
|
|