エクセル2000（マクロ）を使っていくつかの処理を一度にしたい・・・

質問

A列に下記の例のようなデータがあり、件数は毎日変わります。
マクロに登録したいのは
(1)B列にはA列の最終行まで、（例えば）1、2と繰り返し入力させたい
(2)B列に2のデータが入っているものだけを抽出し、抽出したA列のデータだけをコピーし、別のシートに貼り付けたい
というところまでを一つのマクロで処理させたいのですが、うまくいきません。
A列のデータ数は必ず偶数で、数字のみで出てきています。貼付け先は日々のデータを月ごとに表にしていくため、毎日変わります。
※土日祝日分はデータがでてきませんが、項目には記載がありますので、土日祝日は飛ばさなければいけないようになっています。
別シートは行の項目が日付で、列に抽出したデータを入れるようなレイアウトになっています。

A列　　　B列
1　　　　1
1　　　　2
2　　　　1
0　　　　2
10　　　 1
2　　　　2
13　　 　1
2　　　　2

ちなみに私が取得するデータはA列のデータだけなので、B列に入れるデータは1、2でなくてもなんでも大丈夫です。また処理や他にいい考え方等があれば教えてください。
宜しくお願いします。

回答No.2

sacoman · ベストアンサー

土日祝日の判断がよくわかりませんが、単純にA列の偶数行番号の値をリストアップして別シートに表示したいのであれば、B列に値を入力して判定するのではなく、以下のようなループ構造のマクロで処理できます。（的外れであればスミマセン…）

Sub sample()
　　Dim i As Integer
　　i = 2
　　Do
　　If Cells(i, 1) = "" Then Exit Do
　　Range("Sheet2!A" & i / 2).Value = Cells(i, 1)
　　i = i + 2
　　Loop
End Sub

補足

貼り付け方としてはかなり十分です。
こんなにきれいにできるなんてすごいですね☆
ありがとうございました。
別シートに入っている曜日を認識させる関数は
「=TEXT(DATE($A$2,$B$2,B3),"aaa")」を使用してました。
ちなみにＡ２には２００４（西暦）、Ｂ列には１０（月）、Ｂ３～は日付のつもりで１～数字を入れていました。

考えていたのはSheet1のA列に毎日出てくるデータを貼り付けたら、あとはマクロを登録してあるボタンを押したらデータがSheet2の貼付け用のシートに日付順に勝手に入っていってくれるものがいいかなと思っていたので。曜日で認識させないでも土日祝日は除いてデータが自動で入ってくれれば・・・なんて思っていたのですが・・・。
そこまでできそうですか？
（ってずうずうしくってすみません）

回答No.5

TT_TT

このところ忙しかったので回答が遅れてご免なさい～
エラーが出ていたところはシートの設定の仕方がまずかったみたいです。
なおしたのを貼っときます。

Dim intRow As Integer 'シート１列移動用
Dim intRow2 As Integer '別シート列移動用

Dim intFlg As Integer '１と２を交互に入れるためのフラグ
Dim strDay As String '今日の日付を格納
Dim intDay As Integer '別シートから今日の日付を見つける処理のカウント用
Dim intMsgFlg As Integer ' 0：該当日付あり　1：該当日付なし

''初期設定
intRow = 1
intFlg = 1
intRow2 = 2
intMsgFlg = 0

''今日の日付取得
strDay = Year(Date) & "/" & Month(Date) & "/" & Day(Date)

''別シートの今日の日付の位置を検索
For intDay = 2 To 32
If strDay = Sheets(2).Cells(1, intDay) Then
intMsgFlg = 1
Exit For
End If
Next

''別シートに該当する日付がない場合はメッセージを表示し終了
If intMsgFlg = 0 Then
MsgBox "別シートに該当日付がありません", vbOKOnly, "エラー"
Exit Sub
End If

''A列がNull値になるまでB列に1と2を交互に出力
Do
If Sheets(1).Cells(intRow, 1) <> vbNullString Then
Select Case intFlg
Case 1
Sheets(1).Range("B" & intRow).Value = 1
intFlg = 2
Case 2
Sheets(1).Range("B" & intRow).Value = 2
intFlg = 1
End Select
Else
Exit Do
End If
intRow = intRow + 1
Loop

''初期値再設定
intRow = 1

''B列に2が入っていたら別シートの今日の日付の列にA列のデータを入れる
Do
If Sheets(1).Cells(intRow, 2) = 2 Then
Sheets(2).Cells(intRow2, intDay) = Sheets(1).Range("A" & intRow).Value
intRow2 = intRow2 + 1
ElseIf Sheets(1).Cells(intRow, 2) = vbNullString Then
Exit Do
End If
intRow = intRow + 1
Loop

別シートの日付の自動作成や月ごとにシートを自動作成も作っておこうと思ったのですが、ちょっと忙しくなった為出来ませんでしたが、当初のmilko520さんが質問していた内容は最低限動くと思うので試してみて下さい

お礼

お忙しいのに、ありがとうございました。
本当に助かりました。

回答No.4

TT_TT

返事が遅くなりましたがこんな感じでどうでしょうか？別シートの日付のセルは書式設定が日付で"11/11"となっていることを前提としています。

Dim intRow As Integer 'シート１列移動用
Dim intRow2 As Integer '別シート列移動用

Dim intFlg As Integer '１と２を交互に入れるためのフラグ
Dim strDay As String '今日の日付を格納
Dim intDay As Integer '別シートから今日の日付を見つける処理のカウント用

''初期設定
intRow = 1
intFlg = 1
intRow2 = 2

''今日の日付取得
strDay = Year(Date) & "/" & Month(Date) & "/" & Day(Date)

''別シートの今日の日付の位置を検索
For intDay = 2 To 32
If strDay = Sheet2.Cells(1, intDay) Then
Exit For
End If
Next

''A列がNull値になるまでB列に1と2を交互に出力
Do
If Sheet1.Cells(intRow, 1) <> vbNullString Then
Select Case intFlg
Case 1
Sheet1.Range("B" & intRow).Value = 1
intFlg = 2
Case 2
Sheet1.Range("B" & intRow).Value = 2
intFlg = 1
End Select
Else
Exit Do
End If
intRow = intRow + 1
Loop

''初期値再設定
intRow = 1

''B列に2が入っていたら別シートの今日の日付の列にA列のデータを入れる
Do
If Sheet1.Cells(intRow, 2) = 2 Then
Sheet2.Cells(intRow2, intDay) = Sheet1.Range("A" & intRow).Value
intRow2 = intRow2 + 1
ElseIf Sheet1.Cells(intRow, 2) = vbNullString Then
Exit Do
End If
intRow = intRow + 1
Loop

補足

連絡が遅くなってしまい、申し訳ございません。

If strDay = Sheet2.Cells(1, intDay) Then
のところでコンパイルエラーが出てしまい、次になかなか進めません。
変えたのはsheet2の名前を16年11月にしただけなんですが・・・
何がいけなかったのか、わかりますか？

回答No.3

imogasi

(１）別シートは行の項目が日付で、列に抽出したデータを入れるようなレイアウトになっています。
1月１シート、縦に計数、横に日付が流れる形式ですか。
11/1 11/2 11/3 11/4
11 1 　なし　　14
2 3 3
31 12 8
4 5 9
・　　・ ・
＞抽出したA列のデータだけをコピーし、別のシートに貼り付けたい
同一月中は同シートに貼りつけるでしょう？。
＞貼付け先は日々のデータを月ごとに表にしていくため、毎日変わります
毎日、列が変わると言うことでしょう？。
＞土日祝日分はデータがでてきませんが、項目には記載がありますので
項目とは？数値、日付、第３の項目とはなに？
推測して下記を作った。テスト済み。
（データ例）11月２日分（11月1日分は省略）
年月 2004-11 2
1
21
24
4
10
22
3
6
2
3
4
（VBAコード）
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
sn = sh1.Cells(1, "B")
Set sh2 = Worksheets(sn)
d = sh1.Range("A65536").End(xlUp).Row
k = sh1.Cells(1, "C")
j = 2
sh2.Cells(1, k) = DateValue(sh1.Cells(1, "B") & "-" & sh1.Cells(1, "C"))
For i = 2 To d Step 2
sh2.Cells(j, k) = sh1.Cells(i, "A")
j = j + 1
Next
End Sub
（結果）
2004-11-1 2004-11-2
2 1
23 24
11 10
4 3
6 2
4
Sheet1のB列は不要（Step２の利用すればよい）
Sheet名の年月区切りは－を使った。シート名の中に使える
記号だから。

補足

質問の仕方下手で申し訳ないです。

＞抽出したA列のデータだけをコピーし、別のシートに貼り付けたい
同一月中は同シートに貼りつけるでしょう？。
>>抽出した値はそうなります。

＞貼付け先は日々のデータを月ごとに表にしていくため、毎日変わります
毎日、列が変わると言うことでしょう？。
>>はい。そうです。

＞土日祝日分はデータがでてきませんが、項目には記載がありますので
項目とは？数値、日付、第３の項目とはなに？
>>項目とは日付になります。

早速ご回答いただいたVBAを入れてみたのですが、どうもうまくいきませんでした。

Set sh2 = Worksheets(sn)のエラーはすぐ解除できたのですが、
sh2.Cells(1, k) = DateValue(sh1.Cells(1, "B") & "-" & sh1.Cells(1, "C"))のエラーが"ｋ"にする以外思いつかず、私ではどうにもなりませんでした。
手順としてはBOOKのSheetはSheet1とSh1とSh2とsnを作成し、毎日出るデータをSheet1にいれ、マクロを登録しました。
何か足りなかったでしょうか？
すみませんが考えられる原因を教えてもらえますか？

実は、エラーがでているところからどのような操作になっているのかも、大変恐縮ですが、知識不足のため理解できませんでした。
ご解説いただけると助かります。
宜しくお願いいたします。

回答No.1

TT_TT

(2)の「B列に2のデータが入っているものだけを抽出し、抽出したA列のデータだけをコピーし、別のシートに貼り付けたい」とありますがもうちょっと詳しく教えて下さい！
特に「B列に2のデータが入っているもの」の例があればうれしいです

補足

書き方が悪かったみたいですみません。

「B列に2のデータが入っているもの」という意味はオートフィルタをかけてB列にある2のデータの行を抽出するという感じでとらえていただければいいかと思います。

A列　　　　B列
1　　　　　1
1　　　　　2→抽出
2　　　　　1
0　　　　　2→抽出
8　　　　　1
2　　　　　2→抽出
5　　　　　1
2　　　　　2→抽出

コピーし、別シートに貼り付けたいのは→抽出となっているA列にあるデータなのでオートフィルタをかけた場合と同様

A列　　　B列
1　　　　2
0　　　　2
2　　　　2
2　　　　2
↑このA列のデータをコピーして貼付けるという感じです。

ちなみに別シートのレイアウトは

　　11/11　　11/12　　11/13・・・（土日祝日欄あり）
山　　1　　　　　△　　　　◆
川　　0　　　　　△　　　　◆
海　　2　　　　　△　　　　◆
・　　　・　　　　　・　　　　・
・　　　・　　　　　・　　　　・
・　　　・　　　　　・　　　　・

こんな感じで、今日出てきたデータは数字が入っている項目に貼付け、明日出てきたデータは△列以下にはりつけ・・・という風になります。

宜しくお願いします。