Excelマクロで任意の項目の数値を自動コピー

質問

【要望】
Excelのマクロを使用して、任意の項目の数値を、任意のセルへ自動的にコピーしたいです。
さらに、マクロを実行した日付を判別して、データの抽出するセルを自動的に変えるようにしたいです。

【具体例】
マクロを組むことで、Sheet1の「*」の部分にSheet2の数字を参照して、自動的にコピーをするようにしたいのです。
さらに、実際に1月1日の日時にマクロの実行を行えば「1月1日」のデータをコピーし、
次の日、1月2日にマクロの実行を行えば「1月2日」のデータをコピーするようにしたいのです。

//////////////////////////
＜Sheet1＞
　　　　　　　　1月1日　1月2日
　　A社実績　　　　*　　　　　*
　　B社実績　　　　*　　　　　*

＜Sheet2＞
　　　　　　　　1月1日　1月2日
　　B社　　
　　　　目標　　　　1　　　　 1
　　　　実績　　　　1　　　　 1
　　A社
　　　　目標　　　　 1　　　　 1
　　　　実績　　　　 1 　　　　 1
//////////////////////////

【問題点】
(1)Sheet2はSheet1とフォーマットが違うため、単純なセル番地の参照では、思い通りに行かない。
(2)マクロを実行する日時によって、異なる作業を行うマクロにしたいが、思い通りに行かない。

【ヒント】
教えて頂く側の立場がヒントを出すなんて大変恐縮ですが、TODAY関数をうまく利用すればできるのでしょうか...??

以上です。
よろしくお願いします。

回答No.2

keithin · ベストアンサー

元ネタのシート２は当然として、シート１にも１行目に適切な日付を「記入済み」だとする
各社の名称はシート２にも漏れなく記載されているとする
シート２の会社名、目標、実績の位置関係はご相談に例示されている通りだとする

単純に縦横位置を調べて転記するだけです。

sub macro1()
　dim c1 as long
　dim c2 as long
　dim r1 as long
　dim r2 as long
　dim d as long
　dim s as string
　d = date

’各シートの横位置の確定
　c1 = application.match(d, worksheets("Sheet1").range("1:1"), 0)
　c2 = application.match(d, worksheets("Sheet2").range("1:1"), 0)

’シート１の縦位置を巡回
　for r1 = 2 to worksheets("Sheet1").range("A65536").end(xlup).row

　’シート２の縦位置を確定
　　s = worksheets("Sheet1").cells(r1, "A").value
　　s = left(s, len(s)-2)
　　r2 = application.match(s, worksheets("Sheet2").range("A:A"), 0) + 2　’実態に合わせて応用する事

　’転記
　　worksheets("Sheet1").cells(r1, c1).value = worksheets("Sheet2").cells(r2, c2).value
　next
end sub

＃参考
マクロでヤリタイご質問なのでマクロで回答しますが、単純な関数だけでも支障なく解決できるご相談です。
実はマクロじゃなくていいなら、改めて各シートの具体的なレイアウト（どこ番地のセルに何が記入されている）を正確に情報提供して、別途ご相談を投稿してみて下さい。

回答No.1

bin-chan

本日日付の取得はTODAY関数でもNow関数でも可能でしょう。
それよりも必ずＥＸＣＥＬのバージョンを記載するようにしてください。
行列数の制約が異なりますので。

マクロの構成は、最初に日付判定、次に会社別実績の処理ループ、という流れと思います。

ですが、以下はどうなりますか？
・○社実績が列Ａとして、日付は最大いくつ用意してありますか？３６５日分？３６６日分？
　日付の「年」はまったく考慮しなくて良いのですか？２月２９日はどうなる？
・会社は例示の通り、Ａ社・Ｂ社の２社ですか？もしもＣ社も登場するならSheet2のどこに？