[[20170415151506]] 『[20170408223428]『セル内改行データの分割とデー』(くまくま) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『[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


β様
いつもお世話になっております。
ご教示いただきましたコードを使わせていただきましたが、D列の変換もB、C列と同様に
タイプ名のみ、もしくはデータのみの転記をすることは可能でしょうか。

例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.