Ｐａｇｅ 859 ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ 通常モードに戻る ┃ ＩＮＤＥＸ ┃ ≪前へ │ 次へ≫ ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ ▼複数列のデータ抽出したい EBI 03/3/8(土) 22:25 ┗日付が疑問だけど Hirofumi 03/3/9(日) 7:29 ┗Re:日付が疑問だけど EBI 03/3/9(日) 17:46 ┗Re:日付が疑問だけど Hirofumi 03/3/9(日) 18:10 ┗複数列のデータ抽出 EBI 03/3/10(月) 21:10 ─────────────────────────────────────── ■題名 ： 複数列のデータ抽出したい ■名前 ： EBI <ebi@gctv.ne.jp> ■日付 ： 03/3/8(土) 22:25 -------------------------------------------------------------------------
| "当初"というシートの中からQ列が空白であるもののデータを抽出して"期限切迫"というシートに書き出しています。 ここへ、今日から６日後の日付より前のデータの中に、T列またはQ列が空白であるもののデータを抜き出したいのですがどうすればよいでしょうか。 A列は日付が入っています。Z1セルは=Today()としています。 Sub 期限切迫() Dim NewSheet As Worksheet On Error Resume Next 'エラースキップ Set NewSheet = Worksheets("期限切迫") '無かったら失敗する On Error GoTo 0 '元に戻す 'スキップされていたら Nothing If NewSheet Is Nothing Then Set NewSheet = ActiveWorkbook.Worksheets.Add NewSheet.Name = "期限切迫" End If NewSheet.Cells(1, 1).Value = Worksheets("当初").Cells(1, 1).Value NewSheet.Cells(1, 2).Value = Worksheets("当初").Cells(1, 2).Value NewSheet.Cells(1, 3).Value = Worksheets("当初").Cells(1, 3).Value NewSheet.Cells(1, 4).Value = Worksheets("当初").Cells(1, 4).Value NewSheet.Cells(1, 5).Value = Worksheets("当初").Cells(1, 5).Value NewSheet.Cells(1, 6).Value = Worksheets("当初").Cells(1, 6).Value NewSheet.Cells(1, 7).Value = Worksheets("当初").Cells(1, 17).Value NewSheet.Cells(1, 8).Value = Worksheets("当初").Cells(1, 20).Value cc = 2 wc = 2 For Each Datacell In Worksheets("当初").Range("Q2:Q150") 'Q列が空白であるデータを抽出する If Datacell.Value = "" Then NewSheet.Cells(wc, 7).Value = Datacell.Value NewSheet.Cells(wc, 1).Value = Worksheets("当初").Cells(cc, 1).Value NewSheet.Cells(wc, 2).Value = Worksheets("当初").Cells(cc, 2).Value NewSheet.Cells(wc, 3).Value = Worksheets("当初").Cells(cc, 3).Value NewSheet.Cells(wc, 4).Value = Worksheets("当初").Cells(cc, 4).Value NewSheet.Cells(wc, 5).Value = Worksheets("当初").Cells(cc, 5).Value NewSheet.Cells(wc, 6).Value = Worksheets("当初").Cells(cc, 6).Value NewSheet.Cells(wc, 7).Value = Worksheets("当初").Cells(cc, 17).Value NewSheet.Cells(wc, 8).Value = Worksheets("当初").Cells(cc, 20).Value 'またはT列が空白であるデータも抽出したい wc = wc + 1 End If cc = cc + 1 Next Datacell 長くなってすみません。 |
| ちょっと、日付の部分に疑問が残るけど こんな、かんじでどうかな？ 間違っていたらゴメン >ここへ、今日から６日後の日付より前のデータの中に、T列またはQ列が空白であるもののデータを抜き出したいのですがどうすればよいでしょうか。 >A列は日付が入っています。Z1セルは=Today()としています。 例として、今日が2003/03/09でデータ日付が2003/03/15迄と言う意味？ または、今日が2003/03/09なら2003/03/03迄のデータ日付と言う意味？ Sub 期限切迫() Dim i As Long Dim j As Long Dim blnExist As Boolean Dim wksNewSheet As Worksheet Dim wksData As Worksheet Dim vntData As Variant Dim vntWrite(7) As Variant Dim lngListTop As Long Dim lngListEnd As Long Dim lngWriteRow As Long Const cstrWrite As String = "期限切迫" Set wksData = Worksheets("当初") With wksData lngListTop = 2 lngListEnd = .Range("A65536").End(xlUp).Row End With '"期限切迫"シートの存在を確認 For Each wksNewSheet In Worksheets 'もし、存在するなら If wksNewSheet.Name = cstrWrite Then blnExist = True Exit For End If Next wksNewSheet 'もし、存在するなら If Not blnExist Then Set wksNewSheet = ActiveWorkbook.Worksheets.Add wksNewSheet.Name = cstrWrite With wksNewSheet .Range("A1:F1").Value = wksData.Range("A1:F1").Value .Cells(1, 7).Value = wksData.Cells(1, 17).Value .Cells(1, 8).Value = wksData.Cells(1, 20).Value End With End If '書き込み行を設定 lngWriteRow = 2 '"当初"のListの先頭行から最終行まで繰り返す For i = lngListTop To lngListEnd '"当初"シートから１行読みこみ With wksData.Cells(i, 1) vntData = Range(.Offset(, 0), .Offset(, 19)).Value End With 'もし、今日から6日後の日付より前のデータの中に '例として、今日が2003/03/09でデータ日付が2003/03/15迄なら If vntData(1, 1) <= Date + 6 Then '今日が2003/03/09なら2003/03/03迄のデータ日付と言う意味なら ' If vntData(1, 1) <= Date - 6 Then 'Q列若しくはT列が""なら If vntData(1, 17) = "" Or vntData(1, 20) = "" Then '書き込み用配列にデータを代入 For j = 0 To 5 vntWrite(j) = vntData(1, j + 1) Next j vntWrite(6) = vntData(1, 17) vntWrite(7) = vntData(1, 20) With wksNewSheet.Cells(lngWriteRow, 1) '"期限切迫"の１列目を日付に書式設定 .Offset(, 0).NumberFormatLocal = "yyyy/m/d" '"期限切迫"に書き込み Range(.Offset(, 0), .Offset(, 7)).Value = vntWrite End With '書き込み行を更新 lngWriteRow = lngWriteRow + 1 End If End If Next i Set wksData = Nothing Set wksNewSheet = Nothing End Sub |
| ▼Hirofumi さん：EBIです。 ありがとうございました。 >例として、今日が2003/03/09でデータ日付が2003/03/15迄と言う意味？ こちらの意味です。 言葉が足りなくてすみませんでした。 ただし、Q列またはT列のどちらかに日付が入っていたらそのデータは抽出しないとしたいのです。（Q列T列ともに日付が入るセルです） Hirofumiさんて、親近感を覚えてしまいます。（私の兄と同じ名前！） |
| >ただし､Q列またはT列のどちらかに日付が入っていたらそのデータは抽出しないとしたいのです｡ と言う事なら 'Q列若しくはT列が""なら If vntData(1, 17) = "" Or vntData(1, 20) = "" Then を 'Q列かつT列が""なら If vntData(1, 17) = "" And vntData(1, 20) = "" Then に変更しないといけないのかな？ |
| 想い通りの結果になりました。 ありがとうございました。 |