Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


36906 / 76738 ←次へ | 前へ→

【45007】Re:日にちで抽出したいのですが・・・
質問  初心者 E-MAIL  - 06/12/9(土) 21:09 -

引用なし
パスワード
   ▼初心者 さん:
>御忙しい所、申し訳ございません。
>新しいシートはちゃんとできるのですが、データが
>抽出されてきません。どいしたらできるのか教えていただけますでしょうか。
>宜しくお願いいたします。
>
>sheet1
>A1       B1    C1  D1
>日付     社員番号  担当 ファイル
>12月15日 ××    ×× ××
>12月15日 ××    ×× ××
>12月16日 ××    ×× ××
>12月17日 ××    ×× ××
>
>のシートをSheet2に12月15日分だけ抽出させたいのですが
>下のマクロを組んだのですがデータが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

0 hits

【45006】日にちで抽出したいのですが・・・ 初心者 06/12/9(土) 21:03 質問
【45007】Re:日にちで抽出したいのですが・・・ 初心者 06/12/9(土) 21:09 質問
【45008】Re:日にちで抽出したいのですが・・・ Mariko 06/12/9(土) 21:59 発言
【45009】Re:日にちで抽出したいのですが・・・ ponpon 06/12/9(土) 22:45 発言
【45014】Re:日にちで抽出したいのですが・・・ DY 06/12/10(日) 0:34 発言
【45049】Re:日にちで抽出したいのですが・・・ 初心者 06/12/11(月) 9:20 お礼

36906 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free