Excel VBA質問箱 IV

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

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


1261 / 13645 ツリー ←次へ | 前へ→

【75365】いつからいつまでを抽出 キョウコ 14/3/13(木) 11:49 質問[未読]
【75366】Re:いつからいつまでを抽出 kanabun 14/3/13(木) 13:06 発言[未読]
【75367】Re:いつからいつまでを抽出 kanabun 14/3/13(木) 16:15 発言[未読]
【75369】Re:いつからいつまでを抽出 キョウコ 14/3/13(木) 16:53 質問[未読]
【75370】Re:いつからいつまでを抽出 kanabun 14/3/13(木) 17:13 発言[未読]
【75372】Re:いつからいつまでを抽出 キョウコ 14/3/13(木) 17:45 お礼[未読]
【75371】Re:いつからいつまでを抽出 kanabun 14/3/13(木) 17:31 発言[未読]
【75368】Re:いつからいつまでを抽出 kanabun 14/3/13(木) 16:52 発言[未読]

【75365】いつからいつまでを抽出
質問  キョウコ  - 14/3/13(木) 11:49 -

引用なし
パスワード
   こんにちわ。
早速ですが質問です。

シート2に売上と売上予定の日付が書かれているセルがあります。
(K3”2014/3/1” L3”〜” M3”2014/3/20”)売上
(K4”2014/3/21” L4”〜” M4”2014/3/31”)売上予定日

シート1に
売上データが記載されています。
A”顧客” B”品名” C”金額” D”担当” E”売上日or売上予定日”

シート1のデータのE列の日付から(K3からM3まで)シート2の売上の日付のデータを抽出し
シート6へ行ごとコピーしたいのです。

下記のマクロで
K3の日付のマクロを抽出することはできたのですが、
2014/3/1のデータしか引っ張れません。
どうにか試行錯誤しいろいろ試したのですが、
わかりそうもなくこちらで質問させていただきます。
よろしくお願い致します。


Dim ws1 As Range
Dim rng As Range
Dim myStr, ra, rr, myStr2

Sheet6.Cells.ClearContents ←ここでシート6の内容を消去

myStr = DateValue(Sheet2.Range("K3")) ←ここにM3も追加しK3〜M3としたい


Set ws1 = Sheet1.Cells
Set ws2 = Sheet6.Range("A1")
With ws1.Columns("E")

Set rng = .Find(What:=myStr, LookAt:=xlWhole, After:=.Cells(.Cells.Count))
If rng Is Nothing Then 'なかったら
MsgBox "ありません"
Else 'あったら
ra = rng.Address

Do
rr = rr + 1 'カウント
rng.EntireRow.Copy Destination:=ws2.Cells(rr, 1) '行のコピペ
Set rng = .FindNext(rng)
Loop While rng.Address <> ra
Set rng = Nothing
End If
End With

Set ws1 = Nothing
Set ws2 = Nothing

【75366】Re:いつからいつまでを抽出
発言  kanabun  - 14/3/13(木) 13:06 -

引用なし
パスワード
   ▼キョウコ さん:>こんにちわ。

>シート1のデータのE列の日付から(K3からM3まで)シート2の売上の日付のデータを抽出し
>シート6へ行ごとコピーしたいのです。

何年何月何日という単一の日付を見つけるには
ワークシート関数Matchを使います。

しかし、
> いつからいつまでを抽出
「期間を抽出」するにはフィルターを使います。


Sub Filter1() 'AdvancedFilter である期間を抽出コピー
  Dim ws1 As Worksheet
  Dim ws2 As Worksheet
  Dim ws3 As Worksheet
  Set ws1 = Worksheets("Sheet1")
  Set ws2 = Worksheets("Sheet2")
  Set ws3 = Worksheets("Sheet6")
  
  'Sheet2の抽出条件をフィルタオプション用範囲[P1:Q2]にまとめる
  With ws2
    'Sheet1[E1]にある列見出し(「売上日」)をSheet2へコピー
    .[P1:Q1].Value = ws1.[E1].Value
    .[P2].Formula = ">=" & .[K3].Value2 '開始日付
    .[Q2].Formula = "<=" & .[M3].Value2 '終了日付
  End With
  'フィルターオプション(AdvancedFilter)で抽出コピー
  With ws3
    .UsedRange.ClearContents
    ws1.[A1].CurrentRegion.AdvancedFilter xlFilterCopy, _
      CriteriaRange:=ws2.[P1:Q2], CopyToRange:=.[A1]
  End With
End Sub

【75367】Re:いつからいつまでを抽出
発言  kanabun  - 14/3/13(木) 16:15 -

引用なし
パスワード
   期間のレコード抽出に使っているAdvancedFilter は
うまい日本語訳がなく 2003まではメニュ−[データ]-[フィルター]
のなかに [フィルターオプションの設定]としてありました。
2007以後は リボンの[データ]-[並べ替えとフィルター]のなかに
今度は [詳細設定]という名前であります。名前は変わりましたが、
表示されるダイアログは2003までのものと寸分違いがありません。

【75368】Re:いつからいつまでを抽出
発言  kanabun  - 14/3/13(木) 16:52 -

引用なし
パスワード
   (補足2)
今回はある期間内の日付データの抽出ということで、一般機能のFilterを
使いましたが、単一の日付のときなら .Findメソッドが適当かというと、
Findメソッドで日付の検索はやらないほうがいいです。
なぜかというと、日付データのセルには「2010/1/6」のような「日付け型」
の値とともに、内部で計算するために「40512」というシリアル値も
格納されています。
Matchワークシート関数を使うと、セルの「40512」のようなシリアル値を
検索してくれます。
Findを使ったばあいは、シリアル値でなく「日付」を検索しようとします。
Findを使った日付の検索がよく失敗するのは、Findが文字列の検索をする
からです。日付の検索でも、セルの表示形式で検索値を文字列にして
検索しないとまずヒットしません。
ただ、Match関数だと検索範囲の先頭セルから検索していちばん最初に
マッチしたセルの位置を見つけてそれで終わり、です。なので、ある
範囲の中から同じ日付を複数個見つけようとするときは、
Find と FindNext のDo〜Loop でなく、フィルタを使ってください。
今回使ったAdvancedFilter でもいいし、AutoFilter でもいいです。
書き方は 以下の通り

(↓例は 2014/3/1 〜 2014/3/20 までの期間内データを抽出するばあい)
 範囲.AutoFilter 1, ">=" & CDate("2014/3/1"), xlAnd, _
           "<=" & CDate("2014/3/20")

(↓例は 2014/3/1 のレコードだけを抽出するばあい)
 範囲.AutoFilter 1, ">=" & CDate("2014/3/1"), xlAnd, _
           "<=" & CDate("2014/3/1")

一日だけでも、不等号を使い、「以上」「以下」と指定してやるのが、
ポイントです。一日だけだからといって、

 範囲.AutoFilter 1, CDate("2014/3/1")

とすると、失敗します。(たぶんFindのように文字列として検索する
からと思われます)

【75369】Re:いつからいつまでを抽出
質問  キョウコ  - 14/3/13(木) 16:53 -

引用なし
パスワード
   ▼kanabun さん:

早急なご返答ありがとうございました。
しかし、載せていただいたマクロを実行しても
コピーされるのは見出しだけです‥

【75370】Re:いつからいつまでを抽出
発言  kanabun  - 14/3/13(木) 17:13 -

引用なし
パスワード
   ▼キョウコ さん:

>早急なご返答ありがとうございました。
>しかし、載せていただいたマクロを実行しても
>コピーされるのは見出しだけです‥

AdvancedFilterは一般機能ですから、手作業でも実行することができます。

>'Sheet2の抽出条件をフィルタオプション用範囲[P1:Q2]にまとめる
>  With ws2
>    'Sheet1[E1]にある列見出し(「売上日」)をSheet2へコピー
>    .[P1:Q1].Value = ws1.[E1].Value
>    .[P2].Formula = ">=" & .[K3].Value2 '開始日付
>    .[Q2].Formula = "<=" & .[M3].Value2 '終了日付
>  End With

上のコードのように、「Sheet2」の[P1:Q2]範囲に 抽出条件を手作業で書き
Sheet6 をクリアして、Sheet6をアクティブにして AdvancedFilterによる
抽出コピーを実行して確認してみてください。

Sheet2の [P1:Q1]に書く見出しは Sheet1の[E1]と全く同じでないといけません。

抽出日付が 2014/3/1 〜 2014/3/20 だったら、
[P2]には ">=41699" と、
[Q2]には "<=41718" と
書き込んでください。 この 41699 とか 41718 とかはシリアル値です。
マクロでは
> .[K3].Value2
> .[M3].Value2
で取得しています。

【75371】Re:いつからいつまでを抽出
発言  kanabun  - 14/3/13(木) 17:31 -

引用なし
パスワード
   手動でもうまくできないようだったら、
Sheet1のE列の日付データ(サンプルデータ)を 10データくらい、
ここに 提示してください。

たとえば、こんなの?

Sheet1   E列
1     売上日
2      2/15
3      3/1
4      3/1
5      3/3
6      3/3
7      3/5
8      3/10
9      3/20
10      3/25
11      4/1

Sheet2 検索開始日 2014/3/1
    検索最終日 2014/3/20

【75372】Re:いつからいつまでを抽出
お礼  キョウコ  - 14/3/13(木) 17:45 -

引用なし
パスワード
   ▼kanabun さん:

>
>Sheet2の [P1:Q1]に書く見出しは Sheet1の[E1]と全く同じでないといけません。
>
ここが違っていました。
申し訳ありません><
修正したら理想通りに動いてくれました!

ありがとうございました!!

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