[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『[20170408223428]『セル内改行データの分割とデータの並び替え方法』(くまくま)』(くまくま)
いつもお世話になっております。トピが長くなりましたので、新しくたてさせて頂きます。
以下作業をマクロで自動化する方法がありましたら、お教え頂きたく存じます。
元データ
A列 B列 C列 D列
1行目 1 Aグループ Bグループ タイプ1
A1 B1 a_123
A2 B2 b_123
A3
2行目 2 A1 Bグループ a_123
これを以下に成型できればと考えております。
A列 B列 C列 D列
1行目 1 Aグループ Bグループ タイプ1
2行目 2 A1 Bグループ a_123
グループ表
A列 B列
1行目 Aグループ A1
2行目 A2
3行目 A3
4行目 Bグループ B1
5行目 B2
補足
・元データは1セル内にデータが改行で複数入っております。
・A列は一意のID番号が入ります。
・B列、C列に入るものは3パターンあります。
パターン1:一つのセルの一番最初がグループ名、その後改行にてそのグループを構成しているデータが並びます。 意味としてはAグループが実際にほしい情報で、その説明としてグループ構成要素を記入しております。
例 Aグループ ← グループ名
A1 ← グループの構成データ
A2 ← グループの構成データ
A3 ← グループの構成データ
※この場合、このセルにはグループA+A1、A2、A3の計6個のデータの意味はなく
グループA(説明 A1、A2、A3)ということを意味しています。
わかりにくく申し訳ありません。
その為、一つのセル内に
Aグループ
A1
といったパターン(グループ名+グループの構成要素の一部)は存在しません。
パターン2:データのみが1セル内に改行で並びます。
例 A1
B2
パターン3:グループ名のみ入力されている。
例 Aグループ
※パターンが分かれてしまうのは、入力する人によって入力内容にばらつきがあるためです。
グループ名だけ入れる人、グループ名+グループの内容を補足説明として入れる人と
おります。
・D列には以下データが入ります。
例 タイプ1 ← グループ名
a_123 ← グループを構成するデータ
b_123 ← グループを構成するデータ
やりたいこと
・B列、C列について
パターン1:グループ化されているものに関してはグループ名のみ抽出
例 Aグループ Aグループ
A1
A2 ⇒
A3
パターン2:グループ作成されているデータ群に完全一致しない場合は
データをそのまま転記
例 A1 A1
A2 ⇒ A2
※Aグループの構成要素にうちの2つではありますが、A3がなく完全一致ではな いのでデータをそのまま転記したい
パターン3:グループ名のみの時はグループ名をそのまま記載
例 Aグループ ⇒ Aグループ
※データがグループ名かどうかはグループ表のグループ名を参照して判断?
・D列について
D列については、a_ , b_ で始まるものがデータ、
それ以外の文字列で始まる場合はタイプ名となっています。
セル内データが a_ ,b_ で始まっているものはそのまま転記
セル内データがその他の文字列で始まればタイプ名(グループ名)とみなしタイプ名のみ転記
※ B列とC列と同じルールでデータが入っておりますが、グループ表での表記の仕方と元データ表の表記の仕方が異なる為、グループ表を参照することは不可能となっています。
例1 タイプ1 タイプ1
a_123 ⇒
b_123
例2 a_123 ⇒ a_123
成形後データは、当初に相談させて頂きました、
改行で一つのセルにまとめて入っているデータをセル分割して、縦にする方法(タイプ1)と同じ形にしたいと考えております。
どうかご教示のほどよろしくお願い致します。
説明がわかりにくい場合は大変お手数ですが、ご指摘いただけますと大変幸甚で
ございます。
よろしくお願い致します。
< 使用 Excel:Excel2016、使用 OS:Windows8 >
まだ、回答ではありません。
まず、閲覧する人が リンクしやすいように 以下にリンクを。
[[20170408223428]] 『セル内改行データの分割とデータの並び替え方法』(くまくま)
> Aグループ > A1 > といったパターン(グループ名+グループの構成要素の一部)は存在しません。
もしあったら・・という心配はありますが絶対にない! ということでいいのですね? (そもそも、このようなデータ、誰かが入力するんですよね。Aグループといれて、その内訳も正しく A1,A2,A3 といれるって 大変じゃないですか? 間違えることもあるでしょ? そもそも、なぜ、内訳も入力するんですか? Aグループ だけでいいのでは?)
で、
Aグループ A1 A2 A3 A1 A2 A3
や
Aグループ A1 A2 A3 A2 A3
というものもないのですね?
(β) 2017/04/15(土) 15:38
とりあえず想像も含めて。(アップ後 使用しなかった変数を消しました)
Sub Sample3()
Dim dicG As Object
Dim g As Range
Dim tmp As Variant
Dim grp As String
Dim a As Range
Dim y As Long
Dim v As Variant
Dim c As Range
Dim i As Long
Dim w As Variant
Dim d As Variant
Dim x As Long
Dim n(1 To 3) As Long
Dim n1 As Long
Dim n2 As Long
Set dicG = CreateObject("Scripting.Dictionary")
With Sheets("Sheet3") '★紐つけシート
For Each a In .Range("A1").CurrentRegion.Columns("A").SpecialCells(xlCellTypeBlanks).Areas
With a.Cells(1).Offset(-1)
Set dicG(.Value) = CreateObject("Scripting.Dictionary")
For Each g In .Offset(, 1).Resize(a.Count + 1)
dicG(.Value)(g.Value) = True
Next
End With
Next
End With
With Sheets("Sheet1")
ReDim v(1 To .Rows.Count, 1 To 4)
For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
v(i + 1, 1) = c.Value
For x = 1 To 3
w = Split(c.Offset(, x).Value, vbLf)
'★補正
If dicG.exists(w(0)) Then
If UBound(w) > 0 Then '念のため
tmp = Array(w(0))
For y = 1 To UBound(w)
If Not dicG(w(0)).exists(w(y)) Then
ReDim Preserve tmp(LBound(tmp) To UBound(tmp) + 1)
tmp(UBound(tmp)) = w(y)
End If
Next
w = tmp
End If
End If
n(x) = i
For Each d In w
n(x) = n(x) + 1
v(n(x), x + 1) = d
Next
Next
i = WorksheetFunction.max(n(1), n(2), n(3))
Next
End With
With Sheets("Sheet2")
.Cells.ClearContents
.Range("A1").Resize(i, UBound(v, 2)).Value = v
.Select
End With
End Sub
(β) 2017/04/15(土) 16:07
↑ グループ紐つけリストには グループ名に対してメンバーが1つだけのものは無いという前提です。 そういうものがあればおかしくなります。
(β) 2017/04/15(土) 16:24
早急なご連絡誠にありがとうございます。
リンクまで貼っていただき大変お手数をお掛けいたしました。
> > Aグループ
> A1 > といったパターン(グループ名+グループの構成要素の一部)は存在しません。 もしあったら・・という心配はありますが絶対にない! ということでいいのですね? (そもそも、このようなデータ、誰かが入力するんですよね。Aグループといれて、その内訳も正しく A1,A2,A3 といれるって 大変じゃないですか? 間違えることもあるでしょ? そもそも、なぜ、内訳も入力するんですか? Aグループ だけでいいのでは?)
⇒手入力の為、絶対ないとは確かに言いきれません。。
万が一あった場合はエラー表示になるといったことは可能でしょうか。。
後出しで大変申し訳ありません。
また、β様の仰ることは誠にごもっともで内訳は入れてほしくないのですが、立場上内訳は入れないでほしいとは言えない状況におります。。
>グループ紐つけリストには グループ名に対してメンバーが1つだけのものは無いという前提です。
そういうものがあればおかしくなります。 ⇒はいメンバーが1名のグループはございません。こちらは絶対。
どうか宜しくお願い致します。
(くまくま) 2017/04/15(土) 16:27
>万が一あった場合はエラー表示になるといったことは可能でしょうか。。
アップしたコードでは、そこはやっていません。 あくまで、先頭がグループ名だった場合、そのグループに属するメンバがセル内にあれば消してしまいます。
ここを、厳密にチェックしようとすると、結構骨が折れる予感がしますので、とりあえずは 対応したくないですねぇ・・・
やるなら、セル内のメンバで 構成要素の固まり(3つあれば3つ)で消し去り、のこったものに その構成メンバが存在すればエラー・・・・
いやいや、やっぱりやりたくないです。
と書いて、もしかしたら わりあいと簡単にできるかなぁ・・・と。 それであっても、時間がとれないので しばらく待ってもらわなければいけませんが。
エラーの場合は、処理をしない? 処理はするけど、なにか、エラーがわかるようにする?(元シートのセルに色を付けるとか)
いずれにしても、アップしたコードが正しく動くかどうかの確認をお願いします。
( β) 2017/04/15(土) 16:35
ご連絡ありがとうございます。
わがままを申しましてすみません!!
ただでさえ複雑な条件を提示させて頂いておりましたので、もしかしたらマクロでさえも不可能かなと思っておりましたところβ様から秒速で回答いただきました為、調子に乗ってしまいました。
まずは教えていただいたコードを使用させて頂きましてご報告させていただきます。
本当にありがとうございます!
(くまくま) 2017/04/15(土) 17:05
例1
タイプ1
a_123 ⇒ タイプ1
b_123
例2
a_123 ⇒ a_123
タイプ名がある場合はタイプ名のみ、タイプ名(必ずセル内最初のデータがタイプ名となります。)がない
場合、a_ もしくは b_ から始まるデータが入力されている場合はデータをそのまま転記となると
とてもとても助かります。D列に入るデータは必ずa_ もしくは b_ から
始まります。
どうぞよろしくお願い致します。
(くまくま) 2017/04/15(土) 21:38
えっ? そうなってませんか? こちらでは、
1 Aグループ Bグループ タイプ1 A1 B1 a_123 A2 B2 b_123 A3 A4 2 A1 Bグループ b_123
を展開し
|[A]|[B] |[C] |[D]
[1]| 1|Aグループ|Bグループ|タイプ1
[2]| |A4 | |
[3]| 2|A1 |Bグループ|b_123
|
こんなようになりますけど?
( β) 2017/04/15(土) 22:27
先頭がグループ名かどうかは、登録リストを参照しています。 登録リストの タイプ1 と SHeet1 の D列の タイプ1 、全く同じものですか? 一方の末尾にスペースがついているとか、1 が 全角・半角で異なるとか、そういったことはないですか?
( β) 2017/04/15(土) 22:29
申し訳ございません。私の説明不足でございました。
D列に関しましては、登録リストを使用せず、
セル内データの先頭データが a_ もしくは b_ で始まる文字列の場合はデータと判断し、そのまま転記。
a_ b_ から始まらない文字列の場合はグループ名とみなし、グループ名(タイプ名)のみ転記し、
同セル内のそれ以降の要素は転記しないといった判断基準にはできないでしょうか。
※D列のデータは必ず a_ b_から始まります。
またグループ名(タイプ名)は必ずセル内データの一番最初にきます。
例 a_123
タイプ名
は絶対なし
D列データのグループに関しては、登録リストがまだ未完成の為、できましたら登録データを参照しない
方法をお教え頂きたく存じます。無理ばかり言いましてすみません。
もしよろしければご教示頂きたく存じます。
よろしくお願い致します!
(くまくま) 2017/04/15(土) 23:21
今日、明日と時間が取れないので、早くても、コードを書きだすのは明日の夕方以降になります。
(β) 2017/04/16(日) 07:10
時間が取れたので書いてみました。
提案というか『押しつけ』ですが、D列の例外処理、コード内で固定値で処理ロジックを入れると いずれ、メンバが決まった時に、手を入れたコードをまた修正しなければいけなくなります。
登録リストを以下のようにして タイプ1 といった登録もしましょう。 ただし、構成要素としては1行だけ 半角の * にしておきます。 このグループ名に対しては、すべての値が構成要素という扱いにしています。
|[A] |[B]
[1]|Aグループ|A1
[2]| |A2
[3]| |A3
[4]|Bグループ|B1
[5]| |B2
[6]|タイプ1 |*
これは D列のグループ名のみではなく、B,C列についても、もし、そういうものがあれば 登録可能です。
従来、グループ登録が1行だけだと不具合が出る処理でしたが、処理方式を変えてカバーしました。
なお、あわせて 『エラーワーニング』を追加してあります。 エラーがあろうがなかろうが、Sheet2 には 今まで通りの成型を行いますが、以下の条件のものが元シートのセルにあれば 処理の最後にその旨メッセージを表示し、該当の元シートのセルに色を塗ります。
・ワーニング条件
先頭がグループ名登録にあり、メンバとして そのグループの構成要素が1組すべて存在し、それ以上はない。
★ロジックは変えていませんが、コード記述をほんとちょっとだけいじりました。(4/16 21:30)
Sub Sample4()
Dim dicG As Object
Dim dicC As Object
Dim g As Range
Dim erD As Boolean
Dim erA As Boolean
Dim tmp As Variant
Dim grp As String
Dim y As Long
Dim k As String
Dim v As Variant
Dim c As Range
Dim i As Long
Dim w As Variant
Dim z As Variant
Dim d As Variant
Dim x As Long
Dim n(1 To 3) As Long
Dim n1 As Long
Dim n2 As Long
Set dicG = CreateObject("Scripting.Dictionary")
Set dicC = CreateObject("Scripting.Dictionary")
With Sheets("Sheet3") '★紐つけシート
For Each c In .Range("A1").CurrentRegion.Columns("A").Cells
If c.Value <> "" Then k = c.Value
If Not dicG.exists(k) Then Set dicG(k) = CreateObject("Scripting.Dictionary")
dicG(k)(c.Offset(, 1).Value) = True
Next
End With
With Sheets("Sheet1")
ReDim v(1 To .Rows.Count, 1 To 4)
For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
v(i + 1, 1) = c.Value
For x = 1 To 3
erD = False
dicC.RemoveAll
w = Split(c.Offset(, x).Value, vbLf)
'★補正
If dicG.exists(w(0)) Then
If UBound(w) > 0 Then '念のため
z = dicG(w(0)).keys
If z(0) = "*" Then
w = Array(w(0))
Else
tmp = Array(w(0))
For y = 1 To UBound(w)
If Not dicG(w(0)).exists(w(y)) Then
ReDim Preserve tmp(LBound(tmp) To UBound(tmp) + 1)
tmp(UBound(tmp)) = w(y)
Else
If dicC.exists(w(y)) Then erD = True
dicC(w(y)) = True
End If
Next
w = tmp
If dicC.Count <> dicG(w(0)).Count Then erD = True
If erD Then
c.Offset(, x).Interior.Color = vbRed
erA = True
End If
End If
End If
End If
n(x) = i
For Each d In w
n(x) = n(x) + 1
v(n(x), x + 1) = d
Next
Next
i = WorksheetFunction.max(n(1), n(2), n(3))
Next
End With
With Sheets("Sheet2")
.Cells.ClearContents
.Range("A1").Resize(i, UBound(v, 2)).Value = v
.Select
End With
If erA Then MsgBox "グループ名と内訳要素の入力におかしなところがあります" & vbLf & "セルに色を付けてあります"
End Sub
(β) 2017/04/16(日) 17:15
ご多忙の中、コードの作成誠にありがとうございます。
出来たらいいなと夢見たことを全て実現して頂きました。
無理を申しました「エラーワーニング」も取り入れて頂きありがとうございます!
教えて頂きましたコード、大切に使わせて頂きます。
コードの中身勉強させて頂きます。
また、前回作成頂きましたsample1、sample2にも出てきます
.Range("A1").Resize(i, UBound(v, 2)).Value = v
の考え方がどうしてもわからず、教えて頂けないでしょうか。
エクセル処理の負荷を考え、まずはメモリーを確保(行に関しては最大行数)し、
そのメモリー内に書き込み、最後に一気にシートにデータを書き込むといったことを先日教えて頂きました。
そして、別シートに書き込む時に実際の行数を指定することで転記効率悪化を防いでいる。
その為のコードが上記だと認識しております。
ただこのコードの実際の動作が想像できず、
.Range("A1").Resize(i, UBound(v, 2)).Value = v
のiに関しては、最終的な行数となると思うのですが、vには具体的にどのような値が入るのか、
ResizeとUBoundの組み合わせがどの様なことを意味しているのか
もしよろしければ少しかみ砕いてお教え頂きたく存じます。
お忙しい中、大変恐縮でございますが、お時間出来ました際に
ご教示頂けますと大変幸甚でございます。
どうぞ宜しくお願い致します。
(くまくま) 2017/04/16(日) 23:32
まず UBound。UBound は、配列内の次元ごとの最大要素数です。 縦横の2次元配列でいうと 1次元目(縦)の行数は UBound(配列,1) で求めることができます。 2次元目(横)の列数は UBound(配列,2) で求めることができます。
もし、配列が 5行 6列 の大きさなら UBound(配列,1) は 5、UBound(配列,2) は 6 になります。
次に ReSize。
元の領域.ReSize(変更後の行数,変更後の列数) と書きます。 こうすると 元の領域の左上隅のセルから指定された行数、列数を持った領域になります。
たとえば Range("A1").ReSize(5,6) としてやれば、できあがる領域は A1 から下に全部で 5行、
A1 から右に全部で 6列。 つまり A1:F5 という領域になります。
ちょっと 別のポイントで眺めてみましょう。 新規ブックの標準モジュールに以下を貼り付けてください。 それぞれ実行して、実行結果と下記説明を見比べてください。(実行結果はすべて同じです)
2次元配列は 縦横のマトリックス、シート上のセル領域のようなものと、以前コメントしたかと思います。
Test1 は、その『ようなもの』であるセル領域に直接値をセットしています。 このコードは理解できると思っています。
Test2。 これは、セル領域に合わせた配列を生成し、その配列内に値をセットした後、同じサイズを持った領域に転記します。 Test1 と 見比べると、配列のイメージがわくのではと思います。
Test3 も Test4 も Test2 と全く同じコードです。
ただ Test3 は Test2 で、最後の転記の際のセル領域を固定記述しているところを ReSize で表しただけです。 また Test4 は、その ReSIze にあたえる行数、列数を 配列内の UBound情報にしています。
Sub Test1()
Dim i As Long
Dim j As Long
Dim n As Long
Range("A1:F5").ClearContents
For i = 1 To 5 '1行目から5行目まで
For j = 1 To 6 '行ごとに 1列目から6列目まで
n = n + 1
Cells(i, j).Value = n
Next
Next
End Sub
Sub Test2()
Dim i As Long
Dim j As Long
Dim n As Long
Dim v As Variant
Range("A1:F5").ClearContents
ReDim v(1 To 5, 1 To 6) '領域に合わせて5行6列の配列生成
For i = 1 To 5 '1行目から5行目まで
For j = 1 To 6 '行ごとに 1列目から6列目まで
n = n + 1
v(i, j) = n
Next
Next
Range("A1:F5").Value = v
End Sub
Sub Test3()
Dim i As Long
Dim j As Long
Dim n As Long
Dim v As Variant
Range("A1:F5").ClearContents
ReDim v(1 To 5, 1 To 6) '領域に合わせて5行6列の配列生成成
For i = 1 To 5 '1行目から5行目まで
For j = 1 To 6 '行ごとに 1列目から6列目まで
n = n + 1
v(i, j) = n
Next
Next
Range("A1").Resize(5, 6).Value = v
End Sub
Sub Test4()
Dim i As Long
Dim j As Long
Dim n As Long
Dim v As Variant
Range("A1:F5").ClearContents
ReDim v(1 To 5, 1 To 6) '領域に合わせて5行6列の配列生成
For i = 1 To UBound(v, 1) '1行目から配列内最大行まで
For j = 1 To UBound(v, 2) '行ごとに 1列目から配列内最大列まで
n = n + 1
v(i, j) = n
Next
Next
Range("A1").Resize(UBound(v, 1), UBound(v, 2)).Value = v
End Sub
(β) 2017/04/17(月) 13:23
以下コメントは、必ず 上記コメントを理解してから読んでください。 同時に読むと、混乱して、どちらもわからなくなる恐れがありますので。
> まず UBound。UBound は、配列内の次元ごとの最大要素数です。 > 縦横の2次元配列でいうと 1次元目(縦)の行数は UBound(配列,1) で求めることができます。 > 2次元目(横)の列数は UBound(配列,2) で求めることができます。
こう書きました。この表現、厳密にいうと正しくありません。
2次元配列 は 配列(1 To 5, 1 To 6) といったように 開始要素番号 To 終了要素番号 と記述します。 この開始要素番号を LBound といいます。
私が説明した配列、(1 To 5, 1 To 6) これは 私が、行としては開始要素は 1 だよ、終了要素は 5 だよ と宣言しているわけです。 ですから、配列内の行の要素番号は 1,2,3,4,5 。最大要素番号は 5。だから 5行だと。
でも、この開始要素番号は【任意の数字】を指定することができます。 極端にいえば、(10 To 14,20 To 25) こう指定することもできます。 行でいえば 開始が 10。 10,11,12,13,14 とふられますから やはり 5行なんですが、最大要素数は 14 ですね。
まぁ、こんな規定は、よっぽど、こうするほうが、コード記述がすっきりできる、間違いが少なくなる といった場合にしか 使いません。
でも (0 To 5,0 To 6) こういう記述は、今後、たまに見受けられるかもしれません。 あるいは、LBoundを省略して (5,6) こんな記述は、しゅっちゅう出てくると思います。 (私自身は LBound省略は絶対にしませんが)
LBoundを省略すると、特段の設定をしない限り VBA は 0 とみなします。
そうすると、(0 To 5,0 To 6) あるいは (5,6) と宣言した配列は 行で見ると 0,1,2,3,4,5 となり、6行ある ということになります。
なので、正確な要素数 という意味では UBound - LBound +1 ということになります。
●でも、常に、配列宣言を (1 to ■,1 To □) と記述しておけば、■行ある、□列ある ということになります。
(β) 2017/04/17(月) 18:10
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.