[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数行のエクセルデータをキーブレイクするまで横一列のデータに編集』（困ったさん）
次のようなエクセルデータを編集するマクロを教えてもらえませんか？
同一シートでも、別シートでもかまいません。よろしくお願いします。
（入力）
Ａ Ｂ Ｃ Ｄ Ｅ Ｆ
１１１ ０１ １ ５ ０１０ ５
１１１ ０１ １ ５ ０２０ ３
１１１ ０１ １ ５ ０４０ ２
２２２ ０２ １ ５ ０２０ ４
２２２ ０２ １ ５ ０４０ ３
３３３ ０１ １ ５ ０１０ ５
３３３ ０１ １ ５ ０３０ ３
３３３ ０１ １ ５ ０４０ ２
・
・ ・・・n件
（出力）
Ａ Ｂ Ｃ Ｄ Ｅ Ｆ Ｇ Ｈ Ｉ Ｇ Ｋ Ｌ
１１１ ０１ １ ５ ０１０ ５ ０２０ ３ ０４０ ２
２２２ ０２ １ ５ ０２０ ４ ０４０ ３
３３３ ０１ １ ５ ０１０ ５ ０３０ ３ ０４０ ２
・
・ ・・・終わりまで
〔エクセルのバージョン〕2003、〔ＯＳのバージョン〕XPです。
よろしくお願いします。
20040625121028がよく似た構造なので、試してみます。(困ったさん） [[20040625121028]]『マクロで合算』（miyuki）
元データと、結果図だけ載せるのではなく 元データから、何をどうやって結果図のように成るのかの 詳細なご説明も必要だと思います。
以下、推測で。。。。
'------
Sub KOMATTA()
Dim tbl, x
Dim scs As Object
Dim i As Long, xr As Long, xc As Long
Set scs = CreateObject("System.Collections.SortedList")
With Sheets("Sheet1")
tbl = .Range("A1").Resize(.Range("A" & Rows.Count).End(xlUp).Row, 6).Value
End With
On Error Resume Next
For i = 2 To UBound(tbl, 1)
scs.Add tbl(i, 5), ""
Next
On Error GoTo 0
ReDim x(1 To UBound(tbl, 1), 1 To Columns.Count)
xr = 1
For i = 1 To UBound(tbl, 2)
x(1, i) = tbl(1, i)
Next
For i = 2 To UBound(tbl, 1)
If tbl(i, 1) & "_" & tbl(i, 2) & "_" & tbl(i, 3) & "_" & tbl(i, 4) <> _
tbl(i - 1, 1) & "_" & tbl(i - 1, 2) & "_" & tbl(i - 1, 3) & "_" & tbl(i - 1, 4) Then
xr = xr + 1
x(xr, 1) = tbl(i, 1)
x(xr, 2) = tbl(i, 2)
x(xr, 3) = tbl(i, 3)
x(xr, 4) = tbl(i, 4)
End If
xc = scs.IndexOfKey(tbl(i, 5)) + 1
x(xr, xc * 2 + 3) = tbl(i, 5)
x(xr, xc * 2 + 4) = tbl(i, 6)
Next
With Sheets("Sheet2")
.Cells.ClearContents
With .Range("A1").Resize(xr, scs.Count * 2 + 4)
.NumberFormatLocal = "@"
.Value = x
End With
End With
Set scs = Nothing
End Sub
'------
元データがSheet1に、結果をSheet2に書き出します。 Sheet1には1行目が見出し、2行目からデータが入っている事を想定しています。 Sheet2への出力時、セルの書式設定を文字列に変更しています。 集計等が必要な場合は、使えない可能性が有りますので 気をつけて下さい。
(HANA)
Sheet1のE列の値を間に入れ込まなくて良いなら ピボットテーブルでも良さそうに思います。 ピボットテーブルでの結果図 例。 [A] [B] [C] [D] [E] [F] [G] [H] [1] 合計 / Ｆ Ｅ [2] Ａ Ｂ Ｃ Ｄ ０１０ ０２０ ０３０ ０４０ [3] 111 ０１ 1 5 5 3 2 [4] 222 ０２ 1 5 4 3 [5] 333 ０１ 1 5 5 3 2
(HANA)
Ａ列がキー項目で、Ｂ列からＤ列はキーが同じであれはすべて同一。
Ｅ列が商品コードでＦ列が金額のイメージです。
Ａ列のキーが変るまで商品コード金額を順に横に並べて編集することを考えています。
商品コードの数は確定しているので、Ｅ列か？？列までは固定になります。
回答いただきましたようにピボットテーブルも試して見たいと思います。
マクロを先に試して見ましたが、実行時エラー’−216232576（80131700）’オートメションエラーです。の表示となります。
デバッグモードでは、Set scs = CreateObject("System.Collections.SortedList")
でエラーとなっています。ネットでエラーの内容を確認しましたが、内容が分かりません。追加の回答をいただければ幸いです。
(困ったさん）
ピボットテーブルではほイメージのとおり集計できましたが、
コンスタント部分の編集をどうするのかを現在試行錯誤しています。
（困ったさん）
実行時エラー’−216232576（80131700）’オートメションエラーは、
パソコンを代えると無事集計できました。ありがとうございました。
．NET Frameworkを使えなくしていたのかも知れません。
出力時、セルの書式設定の変更方法はまた試行錯誤します。
どうもありがとうございました。（困ったさん）
色々ご報告を頂いているのに なかなか返信出来なくてごめんなさい。
Set scs = CreateObject("System.Collections.SortedList")
は、商品コードを並べ替える為に使用しています。
並べ替える必要が無かったり
どこかに書き出してある順に並べば良かったりするのなら
使わなくて良いですし
他の方法で並べ替えるのなら やはり使用しなくても済みます。
データには、0で始まる数字からのみ成り立っているものが有りますか？ 有るのなら、その部分はやはり先に書式設定を文字列にしておいてから 書き出す必要が有ると思います。 この例や、エクセルが自動で他の物に替えてしまうようなデータが無い場合は 表示形式は余り気にしなくても良さそうに思います。
E列は商品コード・・・これは文字列 F列は金額・・・・・・これは値 他の部分はどうでしょう？ また、エクセルが自動で値として認識して仕舞う様な 文字列が実際もあるのでしょうか？ 他との兼ね合いも有ると思います。 どの様に成っているのが良いのでしょう？
＞商品コードの数は確定しているので、Ｅ列か？？列までは固定になります。 たとえSheet1に無くてもSheet2の表の中には有れば良いのでしょうか？ また、Sheet2の中で 各商品コードが表示される位置は 変わっても良いのでしょうか？ 変わらない方が良いのでしょうか？ どの順番で表示されるのが良いか 等も ご希望が有りそうに思いますが その辺りの詳しいところは、どの様なルールに成っているのでしょう？
しっかりご説明して頂いているのですが 実は分からないことがたくさん有ります。
(HANA)
返事が遅くなしました。まだテスト中で完成にはいたっていません。経過を報告します。
(1) Ｅ列の商品コードはoと５桁の数字、空白もあります。
xc = scs.IndexOfKey(tbl(i, 5)) + 1 でエラーが出たのでオートフィルタで確認すると空白でした。
空白のデータを除外して処理することでエラーを回避していました。
空白もエラー回避できれば幸いです。
実際には、Ｅ列とＦ列の間に商品名があります。
(2) Ｆ列は数値（値）です。 .NumberFormatLocal = "@"を = "0"とすることで計算（集計）もできました。
(3) コンスタント部分に日本語文字列が入る場合もありますが、提案いただいたマクロで難なく編集できました。
(4) Ａ列（キー項目）、Ｅ列でソート済みでしたが、("System.Collections.SortedList")で異常終了し
たときにについても、Set scs = の行をコメント行にしてためしたのですが、scs.Count でエラーにな
り、他のパソコンで試して正常終了し、パソコンの問題点が判明しました。
(5) 試しにＢ列に日本語項目を設定し、Ａ列のキー項目が同一でＢ列の日本語の内容が行毎に変化する
とキーブレイクと判断し、全件Sheet2に書き出しました。
If tbl(i, 1) & "_" & tbl(i, 2) & "_" & tbl(i, 3) & "_" & tbl(i, 4) <> _
tbl(i - 1, 1) & "_" & tbl(i - 1, 2) & "_" & tbl(i - 1, 3) & "_" & tbl(i - 1, 4) Then
で1行前とキーブレイクしていないか確認しているのですね。
(6) Sheet2への書き込みは行ごとでなく一括して出力しているのでしょうか？
お忙しいところ回答いただければと思います。
まず、この掲示板の使い方ですが。。。 文章の先頭に半角スペースを入れると 空行を挟まなくても改行出来るように成ります。 _←ここに半角スペース。
御質問に関してですが
＞(1) Ｅ列の商品コードはoと５桁の数字、空白もあります。 つまり、0で始まって数字のみから成っている物は無い と言う事ですか？ また、空白も有るとのこと。 再度、実際のデータに近いサンプルデータを 載せて頂けると良いのですが。
その際、見出しが有るなら それも御願いします。 また、E列以外でも 0で始まる数字のみから構成されるデータが 有る列があれば、どの列にあるか教えて下さい。
ちなみに、空白の場合はどうするのですか？ また、キー項目&商品コードの組合せで考えたとき データが重複することは有るのでしょうか？ その場合はどの様に処理すればよいのでしょう？
＞(2) Ｆ列は数値（値）です。 ＞(3) コンスタント部分に日本語文字列が入る場合もありますが・・・ (1)の中でも書いていますが 知りたいのは 「エクセルが数値だと思ってしまうような文字列があるか」 です。 例えば、表示形式が標準のセルに入力した場合 01,02,010,020 012 等は、頭の0が無くなってしまいますね。 また、1-2,1/2 等は、日付として認識されてしまいます。 その様なデータがどこかに有りますか？
＞.NumberFormatLocal = "@"を = "0"とすることで計算（集計） 出来るようになりますが、単純にこの部分を変えただけなら 他の部分が意図しない結果に成っている可能性が有ります。
＞(4) Ａ列（キー項目）、Ｅ列でソート済みでしたが ＞(5) ・・・・・・ ＞ 1行前とキーブレイクしていないか確認しているのですね 載せておられるデータが、A列→E列の順でソートされている様でしたので そう言う物としてコードを作成して居ます。 (5)でご指摘の部分で確認をしていますので 現在のコードを変更しないなら ソートされていないと正しい結果になりません。
また、追加のご説明で
＞Ａ列がキー項目で、Ｂ列からＤ列はキーが同じであれはすべて同一。
と有りますので、該当部分は、A列のみ確認すれば良さそうに思います。
If tbl(i, 1) <> tbl(i - 1, 1) Then
当初載せたコードはA〜Dの全ての項目で確認をしていますので。
＞(6) Sheet2への書き込みは行ごとでなく一括して出力しているのでしょうか？ 変数xに行毎に処理したデータを書き込んでいき Sheet2へは、このデータを一括で出力して居ます。
この御質問が、ステップインで実行しながら確認したい と言うご希望に繋がるので有れば ローカルウィンドウを表示して 変数xの中身を確認して下さい。
(HANA)
HANAさんありがとうございます。
ようやくピボットテーブルの結果と照合しながら実データでテストしています。
ピボットでもコンスタント部分も表示できるようになりました。
(1) 実データに近いサンプルは次のとおりです。
店 店名 店員 店員名 C1 C2 C3 C4 C5 商品 商品名 販売実績
010 あ 0010 あかい 1 2 3 4 5 10110 あああ 150
010 あ 0010 あかい 1 2 3 4 5 10150 あいう 250
010 あ 0020 あおい 3 4 5 6 7
010 あ 0030 しろい 8 5 6 7 6 10110 あああ 350
010 あ 0030 しろい 8 5 6 7 6 20150 ＡＡＡ 150
020 う 0050 みどり 5 5 4 7 8 10150 あいう 350
020 う 0050 みどり 5 5 4 7 8 20150 ＡＡＡ 250
030 え 0070 きいろ 6 8 9 9 8 0 ＢＢＢ 0
販売実績がない場合（3件目のデータ）は、コンスタント部分だけの出力。
商品コードが0のものもあります。そのまま商品、品名、実績を出力。
ピボットでは商品順の先頭にあります。ピボットと同様に編集を予定。
データの重複は、フィルタオプションで前処理で削除しています。
商品コードが０のとき変な動きをするため、88888に置き換えると一応正しくなる
ようなのですが・・・(ぜひ回避方法をお教え願います。）
(2) コンスタント部分の店、店員はセルの書式設定で、000又は0000を指定しています。
Ｃ１欄は1983/03/01の日付形式で、書式設定で[$-411]gee.mm.dd;@としています。
(3) 例示いただいた内容を修正しテストして一応できあがりました。
修正箇所のみですが記載します。
.NumberFormatLocal = "@"を = "0"も一応正しくできているようなのですが・・・
tbl = .Range("A1").Resize(.Range("A" & Rows.Count).End(xlUp).Row, 12).Value
For i = 2 To UBound(tbl, 1)
scs.Add tbl(i, 10), ""
Next
For i = 2 To UBound(tbl, 1)
If tbl(i, 1) & "_" & tbl(i, 3) <> _
tbl(i - 1, 1) & "_" & tbl(i - 1, 3) Then
xr = xr + 1
x(xr, 1) = tbl(i, 1)
x(xr, 2) = tbl(i, 2)
x(xr, 3) = tbl(i, 3)
x(xr, 4) = tbl(i, 4)
x(xr, 5) = tbl(i, 5)
x(xr, 6) = tbl(i, 6)
x(xr, 7) = tbl(i, 7)
x(xr, 8) = tbl(i, 8)
x(xr, 9) = tbl(i, 9)
End If
xc = scs.IndexOfKey(tbl(i, 10)) + 1
x(xr, xc * 3 + 7) = tbl(i, 10)
x(xr, xc * 3 + 8) = tbl(i, 11)
x(xr, xc * 3 + 9) = tbl(i, 12)
Next
With .Range("A1").Resize(xr, scs.Count * 2 + 5)
.NumberFormatLocal = "0"
サンプルデータありがとうございます。 一緒に結果図も載せておいて頂けると 良かったのですが。。。
＞販売実績がない場合（3件目のデータ）は、コンスタント部分だけの出力。 Sheet2の方に見出しだけの空列があったら 「そのようなデータがあった」事が分かりますが 無視してしまうと、わからなくなりますよね？ ピボットテーブルで作成した場合も 最後に (空白) の項目が出来ると思いますが 「ここはどうせ非表示にするよ」という扱いで良いのかな？
なお、修正なさった部分ですが Resize(xr, scs.Count * 2 + 5) では、サイズが小さくないですか？ （その他の部分は、問題なさそうに思いますが）
データがご説明の様なものしかないのなら Sheet2の表示形式は先に設定しておいて マクロで制御しない事にしても良さそうに思います。
Sheet2の方も ●店、店員はセルの書式設定で、000又は0000を指定 ●Ｃ１欄は1983/03/01の日付形式で、書式設定で[$-411]gee.mm.dd;@ にしておいて（他は、標準） ↓修正コードを試してみてください。
'------
Sub KOMATTA2()
Dim tbl, x
Dim scs As Object
Dim i As Long, ii As Long, xr As Long, xc As Long
Set scs = CreateObject("System.Collections.SortedList")
With Sheets("Sheet1")
tbl = .Range("A1").Resize(.Range("A" & Rows.Count).End(xlUp).Row, 12).Value
End With
For i = 2 To UBound(tbl, 1)
If tbl(i, 10) <> "" Then '商品に入力があったら
scs(tbl(i, 10)) = "" 'scs に追加
End If
Next
ReDim x(1 To UBound(tbl, 1), 1 To Columns.Count)
xr = 1
For ii = 1 To 9 'A:Iの見出しを設定
x(1, ii) = tbl(1, ii)
Next
For ii = 1 To scs.Count 'J列以降の見出しを設定
x(1, ii * 3 + 7) = tbl(1, 10)
x(1, ii * 3 + 8) = tbl(1, 11)
x(1, ii * 3 + 9) = tbl(1, 12)
Next
For i = 2 To UBound(tbl, 1)
If tbl(i, 1) & "_" & tbl(i, 3) <> _
tbl(i - 1, 1) & "_" & tbl(i - 1, 3) Then
xr = xr + 1
For ii = 1 To 9 'コンスタント部分を転記
x(xr, ii) = tbl(i, ii)
Next
End If
If tbl(i, 10) <> "" Then '商品に入力があったら
xc = scs.IndexOfKey(tbl(i, 10)) + 1
x(xr, xc * 3 + 7) = tbl(i, 10)
x(xr, xc * 3 + 8) = tbl(i, 11)
x(xr, xc * 3 + 9) = tbl(i, 12)
End If '↑データ部分を転記
Next
With Sheets("Sheet2")
.Cells.ClearContents 'Sheet2のデータを削除
.Range("A1").Resize(xr, scs.Count * 3 + 12).Value = x
End With 'Sheet2にデータを書き出し
Set scs = Nothing
End Sub
'------
(HANA)
HANAさん最後までサポートいただきありがとうございました。 返事が遅くなりすみませんでした。 マクロを修正し、ピボットテーブルの結果と照合も終了しました。 見出しがが欲しいとは思っていましたが、希望を予測して修正いただきましたこと 本当にありがとうございました。 'A:Iの見出し設定と'コンスタント部分の転記もすっきりしました。 日付、店コード。店員とも書式設定しておけば意図しているとおりに表示できました。 対話型で処理を記録しマクロを作成するレベルでは、列毎にコピーことを考えていましたが テーブル全体を一括編集後、一括して出力できることを知り大変勉強になりました。 表計算ソフト（エクセル）の底力に驚きを感じています。 本当にお世話になりました。 エクセルの学校のファンになりました。 （困ったさん）
結果が出ましたか。 良かったです。
さて、今回は[ 商品 ]の並べ替えを考え System.Collections.SortedList を使用したのですが、使用できるPCが限定されるのは あまり面白くありません。
現に私も、（実質サブの）メイン機では System.Collections.SortedList でエラーになって 動きません。。。
そこで ＞＞他の方法で並べ替えるのなら やはり使用しなくても済みます。 と書きました様に、他の方法（ワークシート上の並べ替え）を使用して System.Collections.SortedList を使わないコードを作成しました。 （これに関する部分以外のコードは 同じコードにしてあります。） 何かの参考にしていただければ幸いに思います。
'------
Sub KOMATTA_DIC()
Dim tbl1, tbl2, x
Dim dic As Object
Dim i As Long, ii As Long, xr As Long, xc As Long
Set dic = CreateObject("scripting.dictionary")
With Sheets("Sheet1")
With .Range("A1").Resize(.Range("A" & Rows.Count).End(xlUp).Row, 12)
tbl1 = .Value '↓[ 商品 ]を昇順で並べ替え
.Sort Key1:=.Range("J1"), Order1:=xlAscending, _
Header:=xlYes, Orientation:=xlTopToBottom
tbl2 = .Value
For i = 2 To UBound(tbl2, 1)
If tbl2(i, 10) <> "" And tbl2(i, 10) <> tbl2(i - 1, 10) Then
dic(tbl2(i, 10)) = dic.Count + 1
End If 'dicに追加（Itemに順番を入れる）
Next
.Value = tbl1
End With
End With
ReDim x(1 To UBound(tbl1, 1), 1 To Columns.Count)
xr = 1
For ii = 1 To 9 'A:Iの見出しを設定
x(1, ii) = tbl1(1, ii)
Next
For ii = 1 To dic.Count 'J列以降の見出しを設定
x(1, ii * 3 + 7) = tbl1(1, 10)
x(1, ii * 3 + 8) = tbl1(1, 11)
x(1, ii * 3 + 9) = tbl1(1, 12)
Next
For i = 2 To UBound(tbl1, 1)
If tbl1(i, 1) & "_" & tbl1(i, 3) <> _
tbl1(i - 1, 1) & "_" & tbl1(i - 1, 3) Then
xr = xr + 1
For ii = 1 To 9 'コンスタント部分を転記
x(xr, ii) = tbl1(i, ii)
Next
End If
If tbl1(i, 10) <> "" Then
xc = dic(tbl1(i, 10))
x(xr, xc * 3 + 7) = tbl1(i, 10)
x(xr, xc * 3 + 8) = tbl1(i, 11)
x(xr, xc * 3 + 9) = tbl1(i, 12)
End If '↑データ部分を転記
Next
With Sheets("Sheet2")
.Cells.ClearContents 'Sheet2のデータを削除
.Range("A1").Resize(xr, dic.Count * 3 + 12).Value = x
End With 'Sheet2にデータを書き出し
Set dic = Nothing
End Sub
'------
(HANA)
HANAさん重ねがさねサポートいただきありがとうございます。 一連の処理をマクロ化し、連続処理できるようにしていましたので返事が遅れました。 (1) ファイル名を指定してＣＳＶファイルを読み込む。 (2) 支店＞店員＞商品で並べ替え。 (3) 提案いただいたマクロを変形し、重複データの削除 (4) 複数行を横一列に編集 あとは、マクロボタンと指示シートを作成し完成です。 System.Collections.SortedListを使わないマクロも確認したいと思います。 本当にありがとうございました。 （困ったさん）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.