プロが教えるわが家の防犯対策術!

シート1(表1)                シート2(表2)
 A列 B列 C列 D列            A列 B列 C列 D列
1名前 開始日 内容 終了日      1名前 開始日 内容 終了日 
2鈴木 21年1月1日 AAA ○○○    2鈴木 ○○○ ○○○ 21年11月1日 
3高橋 21年1月8日 BBB ○○○    3山田 ○○○ ○○○ 21年11月1日 
4鈴木 21年1月20日 AAA ○○○   4高橋 ○○○ ○○○ 21年11月10日
5鈴木 21年2月10日 BBB ○○○   5高橋 ○○○ ○○○ 22年9月30日
6山田 21年2月13日 AAA ○○○
7佐藤 21年3月3日 CCC ○○○
8高橋 21年11月24日 CCC ○○○
9高橋 21年11月24日 AAA ○○○

上記の表について下記の表になるように求めたいのですが、シート1のデータ数は約17万行、シート2のデータ数は約6万行になります。
他の方の質問を参考に関数で求めようとしましたが、処理が非常に重く、入力した関数も成功しませんでした。
「VBAを使って作業をする」という結論に達しましたが、プログラムを組む知識がなく時間もないため皆さんの力をお借りしたいです。


条件
表2のB~C列は表1を参照し、表1のD列は表2を参照する
B列は、求めるセルのA列(名前)が一致する行を対象として、複数の行が該当する場合はその中でも終了日に最も近い開始日を求める
もし同じ数値があった場合は先に検索で該当した方の値を参照し、求めているセルの文字を赤字へ変更する(下記の表ではシート2のB5が赤字で表示される)
また、開始日<終了日である
C列はB列で該当した開始日のある行のC列の値を求める
D列は各行のA~C列の値が一致した行のD列の値を求める


シート1(表1)                   シート2(表2)
 A列 B列 C列 D列                A列 B列 C列 D列
1名前 開始日 内容 終了日          1名前 開始日 内容 終了日
2鈴木 21年1月1日 AAA ○○○       2鈴木 21年2月10日 BBB 21年11月1日 
3高橋 21年1月8日 BBB 21年11月10日  3山田 21年2月13日 AAA 21年11月1日 
4鈴木 21年1月20日 AAA ○○○      4高橋 21年1月8日 BBB 21年11月10日
5鈴木 21年2月10日 BBB 21年11月1日  5高橋 21年11月24日 CCC 22年9月30日
6山田 21年2月13日 AAA 21年11月1日
7佐藤 21年3月3日 CCC ○○○
8高橋 21年11月24日 CCC 22年9月30日
9高橋 21年11月24日 AAA ○○○

説明がへたくそで申し訳ないですが、よろしくお願いします。

A 回答 (4件)

こんばんは!


データ量が極端に多いみたいなので、かなりの時間を要すると思いますが・・・
一例です。

画面左下のSheet1のSheet見出し上で右クリック → コードの表示 → VBE画面に
↓のコードをコピー&ペーストしてマクロを実行してみてください。
(Alt+F8キー → マクロ → マクロ実行です)

Sub test() 'この行から
Dim i, k, M As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet2") '←「Sheet2」の部分は実際のSheet名に!
Application.ScreenUpdating = False
For i = ws.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
Columns("A:D").AutoFilter field:=1, Criteria1:=ws.Cells(i, 1)
For k = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If WorksheetFunction.CountIf(Range(Cells(2, 2), Cells(k, 2)), Cells(k, 2)) > 1 Then
Rows(k).Hidden = True
End If
Next k
For M = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Rows(M).Hidden = False And Cells(M, 2) <= ws.Cells(i, 4) Then
Range(Cells(M, 2), Cells(M, 3)).Copy Destination:=ws.Cells(i, 2)
ws.Cells(i, 4).Copy Destination:=Cells(M, 4)
End If
Next M
M = Cells(Rows.Count, 1).End(xlUp).Row
For k = 2 To M
If WorksheetFunction.CountIf(Range(Cells(k - 1, 4), Cells(M, 4)), Cells(k, 4)) > 1 Then
Cells(k, 4).ClearContents
End If
Next k
Next i
Worksheets("Sheet1").Select '←「Sheet1」の部分も実際のSheet名に!
Selection.AutoFilter
Application.ScreenUpdating = True
End Sub 'この行まで

※ 検証していませんのでご希望通りの動きにならなかったら
ごめんなさいね。m(_ _)m
    • good
    • 0
この回答へのお礼

こんばんわ。
実際に動作を検証するには明日以降となってしまいます。
また、他の回答者様が言っているように条件が不足、具体性がないことがあげられました。
動作しなくても私の落ち度ですので気にしないでください。
回答を頂きありがとうございます。

お礼日時:2012/06/27 22:39

もっと頭が悪いので、テストデータを作成して、Accessのクエリでやってみましたが、このデータは照合不可能な気がします。


あくまで乱数で作成したデータでの話ですが、1000個と500個のつき合わせで、25000個くらいの候補が挙げられ、収束できそうもありません。

>B列は、求めるセルのA列(名前)が一致する行を対象として、複数の行が該当する場合は
>その中でも終了日に最も近い開始日を求める

とありますが、実際にはある開始日と、内容の組み合わせに対して、複数の終了日の候補が挙げられ、どの終了日が正解かを定めるルールがありません。無理矢理開始日に一番近い終了日が該当とすれば定まりますが、他の「内容」との調整は取れませんので、複数の「内容」で同じ終了日を採用してしまう事が出てきてしまうので、正しいとは思えません。

手作業でのつき合わせができるとすると、種々の前提条件があると思うのですが、#1さんのおっしゃるとおり、それを明確にして、再度質問を立てられるのが良いと思います。
    • good
    • 0

いろんなやり方があると思うけど、アクセスが私にとっては、一番手軽かな。



もうちょっと、問題を整理して、
いや、根本的に何をしたいかもう少し具体的に、
「その他データベース」で質問を立てていただいたほうが良いように思う。

たとえば、

表1には、誰が、何の本を、いつ借りたかが、借りた時間順に入っています。
同一日に複数の本を借りた場合は、複数連続で入っています。
表2には、誰が、直近に借りた本を返した日が入っています。 同一日に複数の本を返した場合でもデータは一つしかありません。
条件としては、一回に複数の本を借りることはできますが、借りた本を返さないで新たに本を借りることはできません。
このデータから、すべてのほんの所在状況を調べたいのですが可能ですか?

みたいにね。
オイラには、データの順番がどのように保障されているか良くわからないし、
あなたが最終的にほしいものが何なのかがはっきり理解しきれない。
(オイラ馬鹿でゴメン。)
    • good
    • 0
この回答へのお礼

>もうちょっと、問題を整理して、
いや、根本的に何をしたいかもう少し具体的に、
「その他データベース」で質問を立てていただいたほうが良いように思う。

次回投稿の際にはもう少しわかりやすいように努力してみます。「みなさんの視点からは抽象的すぎる」ということがわかっただけでも少し前進です。
回答ありがとうございました。

お礼日時:2012/06/27 22:25

17万行を1行ずつ6万行と付け合せるというのは、不可能とは言わないが、ちょっと非現実的。


アクセスでやるのはダメ?

エクセルで色付けについても、開いて目視するのが目的だろうけど、そんなことできるの?
対照リストをクエリで引っ張り出すほうが良いと思う。
    • good
    • 0
この回答へのお礼

すぐに回答を頂きありがとうございます。

>アクセスでやるのはダメ?

エクセルで作業することが難しく、アクセスで作業するほうが良いのでしたら、アクセスでの作業も考慮します。

アクセスを使用したことがないので、アクセスについて下記HPを軽く閲覧しました。
http://www.sk-access.com/index.html

>対照リストをクエリで引っ張り出すほうが良い

この操作を実際のデータで実行するには明日以降になりますが、手作業で付け合せを行うことが不要になりますか?

お礼日時:2012/06/26 18:35

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!