| |
▼初心者 さん：
>御忙しい所、申し訳ございません。
>新しいシートはちゃんとできるのですが、データが
>抽出されてきません。どいしたらできるのか教えていただけますでしょうか。
>宜しくお願いいたします。
>
>sheet1
>A1 B1 C1 D1
>日付 社員番号 担当 ファイル
>１２月１５日 ×× ×× ××
>１２月１５日 ×× ×× ××
>１２月１６日 ×× ×× ××
>１２月１７日 ×× ×× ××
>
>のシートをSheet2に１２月１５日分だけ抽出させたいのですが
>下のマクロを組んだのですがデータがsheet2に抽出できません。
>どうしてなのか教えていただけますでしょうか。
すいません。
マクロは下のように組みました。
宜しくお願いいたします。
Sub 日付抽出()
'---------------------------宣言セクション(各項目 最大1000件まで格納する）---
Dim 日付(1000) As Date
Dim 社員番号(1000) As String
Dim 担当(1000) As String
Dim ファイル(1000) As String
Dim n As Integer
Dim i As Integer
Dim mstr As String
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim TDate As Date
Dim SName As String
'-----------------------メッセージボックスの表示------------------------------
mstr = InputBox("何日を抽出しますか？(数字のみ）", "抽出日指定")
'----------------------該当データを一旦メモリ上に格納する---------------------
Set WS1 = ThisWorkbook.Worksheets("Sheet2")
n = 0
i = 1
Do While WS1.Cells(i + 1, "A") <> "" '----------A列で空欄がくるまで繰り返す
TDate = WS1.Cells(i + 1, "A")
If Month(TDate) = Month(mstr) And Day(TDate) = Day(mstr) Then '----メッセージボックスで入力した月のデータを格納
日付(n) = WS1.Cells(i + 1, "A").Value
社員番号(n) = WS1.Cells(i + 1, "B").Value
担当(n) = WS1.Cells(i + 1, "C").Value
ファイル(n) = WS1.Cells(i + 1, "D").Value
n = n + 1
End If
i = i + 1
Loop
'----------------------抽出シート作成----------------------------------------
Sheets.Add After:=Worksheets(Worksheets.Count) '----------シート挿入
SName = Day(mstr) & "日分" '----------シート名（シート名に『/』は使えない）
ActiveSheet.Name = SName
Set WS2 = ThisWorkbook.Worksheets(SName)
WS2.Range("A1").Value = "日付" '----------項目名
WS2.Range("B1").Value = "社員番号"
WS2.Range("C1").Value = "担当"
WS2.Range("D1").Value = "ファイル"
For i = 0 To n - 1 '-----------メモリ上に格納していたデータを代入
WS2.Cells(i + 2, "A").Value = 日付(i)
WS2.Cells(i + 2, "B").Value = 社員番号(i)
WS2.Cells(i + 2, "C").Value = 担当(i)
WS2.Cells(i + 2, "D").Value = ファイル(i)
Next i
WS2.Range("A1").Select
Range("A2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Set WS1 = Nothing
Set WS2 = Nothing
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 06/12/9(土) 21:03 -
