EXCEL 並び替え 変換 マクロ

質問

以下の写真のようなプログラムをEXCELのVBAで作りたいと思います。
SPLIT関数を用いればいいとは思うのですが
どのように組めばよいでしょうか？

回答No.2

n-jun · ベストアンサー

＃１です。

Dictionaryオブジェクトは不要でした。

Sub try2()
Dim r As Range, rr As Range
Dim v

Set rr = Range("G1")
rr.Resize(, 3).Value = Split("名前 値段 管理番号")

For Each r In Range("D2", Cells(Rows.Count, 4).End(xlUp))

For Each v In Split(r.Value, ",")
Set rr = rr.Offset(1)
rr.Resize(, 2).Value = r.Offset(, -3).Resize(, 2).Value
rr.Offset(, 2).Value = v
Next

Next
Set rr = Nothing
End Sub

かな？

お礼

前回に引き続き、ありがとうございます！
動作を確認させて頂きました。

後でじっくり、動作を学ばせていただきたいと思います。

回答No.3

DOUGLAS_

＞SPLIT関数を用いればいいとは思うのですが
　ポイントは [Split 関数] で区切られた配列から [UBound 関数] で要素数を求め、それぞれの列を [Resize プロパティ] によって要素数の数だけ広げて、元の値をコピーしていく、という点と、I列に関しては、[WorksheetFunction.Transpose 関数] によって、配列を縦方向にあてがう、という点です。

Sub Macro1()
　Dim i As Integer, j As Integer
　Dim myNo As Variant
　For i = 2 To Range("A65536").End(xlUp).Row
　　myNo = Split(Cells(i, 4).Value, ",")
　　j = Range("G65536").End(xlUp).Offset(1).Row
　　With Cells(j, 7).Resize(UBound(myNo) + 1)
　　　.Value = Cells(i, 1).Value
　　　.Offset(, 1).Value = Cells(i, 2).Value
　　　.Offset(, 2).Value = Application.Transpose(myNo)
　　End With
　Next
End Sub

お礼

動作確認いたしました。
６行目以降が分かりにくいので、
これから頑張って把握していきたいと思います！

ありがとうございました。

回答No.1

n-jun

http://okwave.jp/qa4790941.html
の逆パターンと言う事でしょうか？

管理番号には重複がないとの条件なら、

Sub try()
Dim myDic As Object
Dim r As Range, rr As Range
Dim v, myKey

Set myDic = CreateObject("Scripting.Dictionary")

For Each r In Range("D2", Cells(Rows.Count, 4).End(xlUp))

For Each v In Split(r.Value, ",")
myDic(v) = Array(r.Offset(, -3).Value, r.Offset(, -2).Value)
Next

Next

Set rr = Range("G1")
rr.Resize(, 3).Value = Split("名前 値段 管理番号")

For Each myKey In myDic.keys
Set rr = rr.Offset(1)
rr.Resize(, 2).Value = myDic(myKey)
rr.Offset(, 2).Value = myKey
Next

Set myDic = Nothing
Set rr = Nothing
End Sub

でしょうか？