Excel2000での列集計

質問

過去の質問では見つからず、初めて質問させていただきます

【質問】
Code1　Code2　Name　1　2　3　4　5　6　7～
　　　　　　　　　　　　　　月　　　　～　　　日　月　　　　～　　　日
a1　　　111　　あ　　　　Ａ　Ａ　　　　　　　　　　　　Ａ
a1　　　111　　あ　　　　　　　　　　　　　　　　　Ｂ　Ｂ
a1　　　111　　あ　　　　　　Ｃ　Ｃ　Ｃ　　　　　　Ｃ
a2　　　222　　い　　　　　　　　　　　　　　　　　　　Ａ　Ａ
a2　　　222　　い　　　　Ｂ　Ｂ
a2　　　222　　い　　　　　　Ｃ　Ｃ　　　　　　　　　　Ｃ　Ｃ
a2　　　222　　い　　　　　　　　　　　　　　　　　　　Ｄ
a3　　　333　　う　　　　Ａ　Ａ
a3　　　333　　う　　　　　　　　　　　　　　　　　Ｂ
　　・
　　・

上の1年分のデータ表を下記のような週毎に月曜日のみ残した表にその週にあるデータ(文字列)を月の列に集め、空白の行は上に詰めて表示させ、詰めたことによって全ての月曜日の列(1年分)にデータの無い行は削除したい

Code1　Code2　Name　　1　　8　～
　　　　　　　　　　　　　　　月 月
a1　　　111　　あ　　　　　Ａ　Ａ
a1　　　111　　あ　　　　　Ｃ　Ｂ
a1　　　111　　あ　　　　　　　Ｃ
a2　　　222　　い　　　　　Ｂ　Ａ
a2　　　222　　い　　　　　Ｃ　Ｃ
a2　　　222　　い　　　　　　　Ｄ
a3　　　333　　う　　　　　Ａ　Ｂ

同人の行の中ではひとつの行には同じデータしかない
"あ"の3行はA行B行C行になっています
"い"の4行中には、またABCそれぞれの行があり加えてD行もある
"う"の行はAとBのみなので行が少ない

関数でも試したのですが無理で、マクロでしかできないのではと思っています。
マクロは良く分からないのでお分かりになる方教えて下さい。お願いします。

回答No.3

imogasi · ベストアンサー

上の行へ詰める処理を載せます。＃２の補足の対処策は次回にします。
ただロジックは結構しつこく、＃２の補足を拝見すると、判ってもらうのが難しいかもしれませんね。
少数例でテストしてますが、テストデータを作るのが
面倒な問題で、バグがあるかもしれませんのでその際はお許しを。
（前準備）Sheet2をそっくりsheet3にコピーしてください。
（後処理）まだ空白行を省く処理が残っていますが、手作業で行削除をされてはどうですか。
（コード）
Sub test02()
Dim sh3 As Worksheet
Set sh3 = Worksheets("sheet3")
d = sh3.Range("d3").CurrentRegion.Rows.Count
r = sh3.Range("d3").CurrentRegion.Columns.Count
' MsgBox d
' MsgBox r
d = d + 1
sh3.Cells(d, 1) = "end" '終わりをわざと作る
s = 3
mkey = sh3.Cells(3, 1) & sh3.Cells(3, 2) & sh3.Cells(3, 3)
For i = 3 To d
key = sh3.Cells(i, 1) & sh3.Cells(i, 2) & sh3.Cells(i, 3)
If mkey <> key Then
'---同じキーブロック内で上へ詰める処理
l = i - 1
' MsgBox s & "=" & l
For j = 4 To r '全列左より右へ
For k = s + 1 To l '同じキーブロック内で
For m = k To s + 1 Step -1
If sh3.Cells(m - 1, j) = "" Then
sh3.Cells(m - 1, j) = sh3.Cells(m, j)
sh3.Cells(m, j) = ""
End If
Next m
Next k
Next j
'--------
s = i '同じキーブロックの先頭行を置換え
Else
'キーが変らない行の処理
End If
mkey = key
Next i
'-----最後処理
sh3.Cells(d, 1) = ""
End Sub

回答No.5

imogasi

＞D2のセルから月～日の繰り返しで、20030630は月で終わっています－－＞ではＤ１・Ｅ１・Ｆ１・・・の第１行は何が入っていますか。
Ｄ３・Ｅ３・Ｆ３・・・は何が入っていますか。曜日ですか。
Ｄ１＝，Ｄ２＝、Ｄ３＝、Ｅ１＝、Ｅ２＝，Ｅ３＝、Ｆ１＝、Ｆ２＝，Ｆ３＝に何が入っているか実例で書いてみてください。
＞どうも、半年分のデータを全てE列に集まる形になっているようですが－－＞ＮＯ。月曜日にその１週間分をまとめているつもり。基本は間違っていないとおもう。ただ大切な「日付」の入力セルや文字列かエクセル本来の日付け
方式でないなどの説明が不十分で、食い違いが出ているかも。日付けの捉え方が狂うと結果はすべてだめ。
＞1行目 20030106～ 20030112 20030113～ 20030119 と
2行目は、D2のセルから月～日の繰り返しで、20030630は月
－－＞矛盾していませんか。１行と２行目とどちらなんですか。
＞その表のD列～J列（1/6～1/12の週）のデータをD列（月曜日の列）に集め、 －－＞私は２００３／１／１から始まると思っていましたが、１月６日から始まるのですか。
Ｄ１は１月６日？
＞その次の週のデータはF列にという具合に最後の列のGD列（6/30）まで続けます。 －－＞月末日を関係なく、半年を
月－日曜のスパンで、月曜日に横に縮めるイメージですね。この点ではこのつもりで作りました。また私は曜日は
日付から割り出しているので、セルに月・火・水があっても使いません。
●本件のような、業務・仕事の丸投げ的課題は、（１）テストデータが当方で作りにくく（２）細かい会社のルール
やニーヅや業界慣習が伝わらず（３）スキルについても
あれこれいえず（４）質問の意味を捉えるのが苦労あり（５）メールでの応答だけのやり取りなどの制約があって難しいと思います。
ある程度回答者が組んだプログラムが読めて、その意を汲んで、質問者側で、不適当部分は正し、チューニングできないと難しいと思います。仕事問題をＯＫＷＥＢでやるのは難しいと判るのも経験ですが。
あと多少は付き合いますが、よろしく。

お礼

imogasiさん、お礼が遅くなって申し訳ありませんでした。
今回の質問では、私の知識不足により、せっかくご回答をいただいたのに活用できず、ご迷惑をおかけ致しました。
あれから2ヶ月程、日々インターネットで私でも理解できるフリーのサンプルマクロを見つけ、私なりに切り貼り変更し、どうにか使えるマクロができあがりました。
imogasiさんよりNo.3でご回答頂いたマクロも使わせていただきました。
本当にありがとうございました。
よって、この質問は締め切らせて頂きます。
失礼いたします。

補足

元の表は（多少忠実な表にした為、最初に質問した時の表とは少し変わります。）
1行目が年月日の行です。
A1=ブランク,B1=ブランク,C1=ブランク,D1=20030106,E1=20030107,F1=20030108,G1=20030109,・・・・・FW1=20030630
2行目が曜日の行です。
A2=ブランク,B2=ブランク,C2=ブランク,D2=月,E2=火,F2=水,G2=木,H2=金,I2=土,J2=日,K2=月,L2=火,M2=水,・・・・・FW2=月
3行目からデータが入っています。（A列はCode1,B列はCode2,C列はName,D列からデータ）
A3=a1,B3=00111,C3=あ,D3=Ａ,E3=Ａ,F3=ブランク,G3=ブランク,H3=ブランク,I3=ブランク,J3=ブランク,K3=ブランク,L3=Ａ,M3=ブランク,・・・・・
A4=a1,B4=00111,C4=あ,D4=ブランク,E4=ブランク,F4=ブランク,G4=ブランク,H4=ブランク,I4=ブランク,J4=ブランク,K4=Ｂ,L4=Ｂ,M4=ブランク,・・・・・
A5=a1,B5=00111,C5=あ,D5=ブランク,E5=Ｃ,F5=Ｃ,G5=Ｃ,H5=ブランク,I5=ブランク,J5=ブランク,K5=Ｃ,L5=ブランク,M5=ブランク,・・・・・
A6=a2,B6=00222,C6=い,D6=ブランク,E6=ブランク,F6=ブランク,G6=ブランク,H6=ブランク,I6=ブランク,J6=ブランク,K6=ブランク,L6=Ａ,M6=Ａ,・・・・・
A7=a2,B7=00222,C7=い,D7=Ｂ,E7=Ｂ,F7=ブランク,G7=ブランク,H7=ブランク,I7=ブランク,J7=ブランク,K7=ブランク,L7=ブランク,M7=ブランク,・・・・・
A8=a2,B8=00222,C8=い,D8=ブランク,E8=Ｃ,F8=Ｃ,G8=ブランク,H8=ブランク,I8=ブランク,J8=ブランク,K8=ブランク,L8=Ｃ,M8=Ｃ,・・・・・
A9=a2,B9=00222,C9=い,D9=ブランク,E9=ブランク,F9=ブランク,G9=ブランク,H9=ブランク,I9=ブランク,J9=ブランク,K9=ブランク,L9=Ｄ,M9=ブランク,・・・・・
A10=a3,B10=00333,C10=う,D10=Ａ,E10=Ａ,F10=ブランク,G10=ブランク,H10=ブランク,I10=ブランク,J10=ブランク,K10=ブランク,L10=ブランク,M10=ブランク,・・・・・
A11=a3,B11=00333,C11=う,D11=ブランク,E11=ブランク,F11=ブランク,G11=ブランク,H11=ブランク,I11=ブランク,J11=ブランク,K11=Ｂ,L11=ブランク,M11=ブランク,・・・・・
このように行数は結構な量があり、人数が何人なのか同人の行が何行あるのかも数えられる量ではありません。縦に1699行、横はFWの列が最終列になっている表です。
>私は２００３／１／１から始まると思っていましたが、１月６日から始まるのですか。Ｄ１は１月６日？<
はい、すみません。これも今年のカレンダー通りに変更させていただきました。
今年の最初の月曜日からという事です。
文字列かどうかの件ですが、これはセルの書式設定の表示形式においてB3からB1699（データの入っている最後の行が1699行なので）までのセルが文字列になっていて、その他のセルは標準になっています。
B列のCode2のみ数字の頭に0が付くので、文字列にする必要があります。
最初は、Sheet1全てのセルを文字列にしていたのですが、どちらにしたらいいのでしょうか?この設定もなんらかの影響を受けていると思うので教えて頂けるとうれしいです。
私の知識不足で大変ご迷惑をおかけしています。
>ある程度回答者が組んだプログラムが読めて、その意を汲んで、質問者側で、不適当部分は正し、チューニングできないと難しいと<
本当にその通りです。"丸投げ的課題"になってしまい恥ずかしいかぎりです。
ですが、どうかもう少しだけお付き合い願えないでしょうか?
お願いします。

回答No.4

imogasi

#2の補足に付いて
●半年分－－－＞それならわかります（質問には書いてない）
●DateSerial(y1, m1, d1)のところで引っかかってしまいました。－－－＞
（１）1行目には、D1のセルから右に20030106～20030630までこのような形で入力されていると考えてください。
－－－＞文字列で入っているのですね。（これも質問に書いてない。）
私の元（＃２）のy1,m1,d1を
s = sh1.Cells(1, j) '第１行第ｊ番目列
y1 = Val(Mid(s, 1, 4))
m1 = Val(Mid(s, 5, 2))
d1 = Val(Mid(s, 7, 2))
ds = DateSerial(y1, m1, d1)
ys = Weekday(ds)
に置き換えて下さい。但しｄｓ＝、ｙｓ＝の部分は変更なし。
●Ａ，Ｂ、Ｃ・・などの実質のデータが入るのは（３，４）から、右且つ下で良いですね。
●2行目は、D2のセルから月～日の繰り返しで、20030630は月で終わっています。 －－－－＞私には理解できません。
なぜ繰り返しなのか。

補足

imogasiさん、どうも私の説明が悪いようで通じていないようです。
まず最初にExcelで256列以上入力不可能と知らなかったので、
1年分を一騎に処理しようと思っていましたが、半年分の処理に変更しました。
そして、全て文字列になっています。
●Ａ，Ｂ、Ｃ・・などの実質のデータが入るのは（３，４）から、右且つ下で良いですね。
その通りです。
●2行目は、D2のセルから月～日の繰り返しで、20030630は月で終わっています。 －－－－＞私には理解できません。なぜ繰り返しなのか。
ここが通じていなかったようです。
どうも、半年分のデータを全てE列に集まる形になっているようですが、
元の表は、1行目（年月日）はD1のセルより、2行目（曜日）はD2のセルより右に
　1行目 20030106～ 20030112 20030113～ 20030119
　2行目 月 火 水 木 金 土 日 月 火 水 木 金 土 日
のように20030630の月曜日まで続きます。
最後の週のみ6月30日の月曜日で切れています。（7月のデータはいりません）
その表のD列～J列（1/6～1/12の週）のデータをD列（月曜日の列）に集め、
続いてK列～Q列（次の1/13～1/19の週）のデータをE列（この列が1/13～1/19の週の列になる）に集めて、
その次の週のデータはF列にという具合に最後の列のGD列（6/30）まで続けます。
D列からAD列までの27列が残るはずで、1行目にはD～AD列まで全て月曜日の日にちのみが右に並び、
2行目には"月"のみが右に並んでいるようにしたいのです。
そして第2段階の行の削除なのですが、これは同人のデータのみでの処理です。
長くなりました、すみません。
宜しくお願いします。

回答No.2

imogasi

マクロが判らないというより、フローチャート（ロジック）作成の問題と認識すべきです。
補足に対する回答有難うございました。判りました。
２ステップに分けるほうが判り易いと思いますので分けます。
まず列を縮約する処理を下記に載せます。少数例でテスト済み。
（仮定１）第１行は毎日（列）に、月数字が入っていると仮定。今年２００３年と仮定。
（仮定２）月を越えて次の月曜がある週で、月末で切っていない。（月末までと月初から月曜までに分けていない）
（仮定３）１表は２５６列が限度ですが（３６５日入れられませんが、）どうするか、疑問のまま２５６列以内と仮定。
（１）源データ（Ｓｈｅｅｔ１）の保存、繰り返しテストのやりやすさのために、別シートＳｈｅｅｔ２に目的の結果データを作る。
（２）下記プログラムロジックとなる。
（Ａ）初期値セット。
　　　Ｓｈｅｅｔ１のセル（３，３）よりスタート。
　　　ｉ＝３、ｊ＝４
　　　Ｓｈｅｅｔ２もセル（３，４）よりスタート。
　　　ｋ＝３，ｍ＝４　
（Ｂ）Ｓｈｅｅｔ１の最下行か－－－－＞処理終わり。
　　　最下行を調べｆｏｒ・ｎｅｘｔでやればこのステップなし。
Ｓｈｅｅｔ１の最右行か－－－－＞この行の処理終わり。次行の処理へ。ｉ＝ｉ＋１
　　　最下行を調べｆｏｒ・ｎｅｘｔでやればこのステップなし。
（Ｃ）Ｓｈｅｅｔ１の最右列か－－－－＞＜であるとき＞
　　　　　　　　　　　　　　　　　　　Ｓｈｅｅｔ１の　　　　　　　　　　　　　　　　　　　次ぎの行へ進む
　　　　　　　　　　　　　　　　　　　ｉ＝ｉ＋１。　　　　　　　　　　　　　　　　　　　　そして（Ｂ）　　　　　　　　　　　　　　　　　　　　へ。
（Ｄ）月曜日か（１行ｊ列＆２行ｊ列で曜日判定）－－＞　＜であるとき＞　　　　　月日セット。
　　　　　　　　　　　　　Ｓｈｅｅｔ２でｍ＝ｍ＋１。
　＜でないとき＞　　　　　（Ｅ）へ。
（Ｅ）セル（ｉ，ｊ）は空白か。－－＞（Ｇ）へ。
（Ｆ）Ｓｈｅｅｔ１のセル（ｉ，ｊ）をＳｈｅｅｔ２のセル（ｋ、ｍ）へセット。（前日等と同じでも上書きする。ロジックを単調にするため）
（Ｇ）Ｓｈｅｅｔ１の次ぎの列へ進む。ｊ＝ｊ＋１
（Ｈ）（Ｃ）へ行く。
－－－－－－－－－－－－－－－－－
Sub test01()
Dim sh1, sh2 As Worksheet
Set sh1 = Worksheets("sheet1")
Set sh2 = Worksheets("sheet2")
d = Range("d3").CurrentRegion.Rows.Count
r = Range("d3").CurrentRegion.Columns.Count
'----
For i = 3 To d
k = i
m = 4
sh2.Cells(1, m) = sh1.Cells(1, 4)
sh2.Cells(2, m) = sh1.Cells(2, 4)
m = m + 1
For j = 4 To r
'------
y1 = 2003
m1 = sh1.Cells(1, j)
d1 = sh1.Cells(2, j)
ds = DateSerial(y1, m1, d1)
yb = Weekday(ds)
'---月曜日か
If yb = 2 Then
sh2.Cells(1, m) = sh1.Cells(1, j)
sh2.Cells(2, m) = sh1.Cells(2, j)
m = m + 1
End If
'----セル空白でないか--
If sh1.Cells(i, j) <> "" Then
sh2.Cells(k, m) = sh1.Cells(i, j)
End If
Next j
Next i
End Sub

補足

imogasiさん、早々のご回答ありがとうございます。
ですが、私の知識では少し難しいようで理解できません。すみません。
Sub test01() からEnd Subまでがマクロですよね。
これをVBAのModule1に貼り付けさせていただき実行したところds = DateSerial(y1, m1, d1)のところで引っかかってしまいました。
多分1行目の仮定が違うせいだと思うのですが、私には直す事ができません。
ちなみに1行目には、D1のセルから右に20030106～20030630までこのような形で入力されていると考えてください。（半年分）
2行目は、D2のセルから月～日の繰り返しで、20030630は月で終わっています。
どこを変えればいいのか、教えていただけると助かります。
何度も申し訳ありませんが、宜しくお願いいたします。

回答No.1

imogasi

●「同人の行の中ではひとつの行には同じデータしかない」らしいが、確かに元データ例ではそうなっている。
●しかしまとめた表では 「a1　　　111　　あ　　　　　Ｃ　Ｂ」 や「a2　　　222　　い　　　　　Ｂ　Ａ」 では異種が混じっている。（ＣとＢ、ＢとＡなど）。
●これはどういうことですか。上下行のまとめ（縮約）はするのですか。

補足

imogasiさん、分かりにくくてすみません。
まず同人の１週間（1/1～1/7）のデータを全て1/1（月）の列にまとめ

Code1　Code2　Name　　1　　8　～
　　　　　　　　　　　　　　　月 月
a1　　　111　　あ　　　　　Ａ　Ａ
a1　　　111　　あ　　　　　　　Ｂ
a1　　　111　　あ　　　　　Ｃ　Ｃ
a2　　　222　　い　　　　　　　Ａ
a2　　　222　　い　　　　　Ｂ
a2　　　222　　い　　　　　Ｃ　Ｃ
a2　　　222　　い　　　　　　　Ｄ
a3　　　333　　う　　　　　Ａ
a3　　　333　　う　　　　　　　Ｂ

このような形にしてから、データの欄の空白セルを削除して上に詰めて、データの無くなった行を削除して

Code1　Code2　Name　　1　　8　～
　　　　　　　　　　　　　　　月 月
a1　　　111　　あ　　　　　Ａ　Ａ
a1　　　111　　あ　　　　　Ｃ　Ｂ
a1　　　111　　あ　　　　　　　Ｃ
a2　　　222　　い　　　　　Ｂ　Ａ
a2　　　222　　い　　　　　Ｃ　Ｃ
a2　　　222　　い　　　　　　　Ｄ
a3　　　333　　う　　　　　Ａ　Ｂ

という形にしたいのです。
本当に分かりにくくてすみませんでした。
宜しくお願い致します。