[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『横に続いているデータを縦に変換したいです。』（IKD）
下記の[現状]から[変換後]の様にデータを変えたいですが、
データが大量にある為、1つ1つコピペ等は行えません。
初心者の為、効率的な方法が思い浮かびません。
どなたか御教授いただけますと幸いです。
[現状]
A列 B列 C列 D列 E列 F列 G列 ・・・・・ 1 コード 商品名 色 サイズ?@ JAN?@ サイズ?A JAN?A ・・・・・ 2 1111 パンツ 黒/茶 S 111111 M 111112 3 2222 スカート 青 S 222221 M 222222 4 3333 靴 白 S 333331 M 333332 5 4444 帽子 茶 M 444441 L 444442
[変換後]
A列 B列 C列 D列 E列 1 コード 商品名 色 サイズ JAN 2 1111 パンツ 黒/茶 S 111111 3 1111 パンツ 黒/茶 M 111112 4 2222 スカート 青 S 222221 5 2222 スカート 青 M 222222 6 3333 靴 白 S 333331 7 3333 靴 白 M 333332 8 4444 帽子 茶 S 444441 9 4444 帽子 茶 M 444442
サイズ列とJAN列は数字毎に対になっております。
サイズ?@のJANはJAN?@の項目のJANになります。
G列以降サイズ・JANのセットが最大で10個程続きます。
大量にデータがありますので効率的な方法を
御教授くださいますようお願い申し上げます。
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
対になってるとかよくわからないけど、D列E列のセットがV列W列まで続くってことだよね？
Sub 横から縦()
Dim tbl
tbl = Range("W1", Cells(Rows.Count, "A").End(xlUp)).Value
Dim Result
ReDim Result(1 To UBound(tbl, 1) * 10, 1 To 5) '最大10、項目5
Result(1, 1) = "コード"
Result(1, 2) = "商品名"
Result(1, 3) = "色"
Result(1, 4) = "サイズ"
Result(1, 5) = "JANコード"
Dim r As Long, c As Long
Dim rr As Long
rr = 2
For r = 2 To UBound(tbl, 1)
For c = 4 To 22 Step 2
If tbl(r, c) <> "" Then
Result(rr, 1) = tbl(r, 1)
Result(rr, 2) = tbl(r, 2)
Result(rr, 3) = tbl(r, 3)
Result(rr, 4) = tbl(r, c)
Result(rr, 5) = tbl(r, c + 1)
rr = rr + 1
End If
Next c
Next r
With Sheets.Add(after:=Sheets(Sheets.Count))
.Range("A1:E1").Resize(UBound(Result, 1)) = Result
End With
End Sub
これでどうでしょう？ 提示された結果と違うけど。 [A] [B] [C] [D] [E] [1] コード 商品名 色 サイズ JANコード [2] 1111 パンツ 黒/茶 S 111111 [3] 1111 パンツ 黒/茶 M 111112 [4] 2222 スカート 青 S 222221 [5] 2222 スカート 青 M 222222 [6] 3333 靴 白 S 333331 [7] 3333 靴 白 M 333332 [8] 4444 帽子 茶 M 444441 [9] 4444 帽子 茶 L 444442
（稲葉） 2014/10/15(水) 13:24
早急な御対応ありがとうございます。
思い通りの表が作成できました。
稲葉様の解釈通りサイズとJANのセットが横に続いているという事です。
因みに変換後の表を全て文字列で表示する方法はあるでしょうか。
0から始まるコードやJANがあり全て消えてしまいます。
あと、サイズ・JANの前に反映させたい項目を追加したい場合は
Result(1, 1) = "コード"の部分を項目毎に増やしていけば 問題ないでしょうか。
御回答いただけますと幸いです。
何卒宜しくお願い致します。
（IKD） 2014/10/15(水) 14:11
泥臭くやってるので、手直しするところは沢山あります。 Redimのところも増やす必要がありますし、最後の出力範囲も修正する必要があります。
まあやってみて思い通りにならなかったら、また表を提示して頂ければこちらで修正しますので とりあえず間違えてみてください！ （稲葉） 2014/10/15(水) 14:52
御教授ありがとうございます。
数値の「0」が消えてしまう問題も表示形式の指定を行ったので
クリアできました。
また分からない事がありましたら宜しくお願い申し上げます。
（IKD） 2014/10/16(木) 10:45
1つ問題に直面しております。
項目の追加を行いたいのですが、項目追加のコードが分かりません。
商品と色の間に「仕入先・ブランド・シーズン・定価・定価(税)・単価」の
6項目を追加したいです。
そしてサイズ・JANがAK列まで続いております。
列の並びは下記の様になります。
A列 B列 C列 D列 E列 F列 G列 H列 I列 J列 K列・・・・・AK列
コード 商品名 仕入先 ブランド シーズン 定価 定価(税込) 単価 色 サイズ1 JAN1・・・・JAN14
現在は下記のコードで作業しておりますが、
項目追加が出てきて壁にぶつかっております。
Sub ?A()
Dim tbl
tbl = Range("W1", Cells(Rows.Count, "A").End(xlUp)).Value
Dim Result
ReDim Result(1 To UBound(tbl, 1) * 10, 1 To 5)
Result(1, 1) = "コード"
Result(1, 2) = "商品名"
Result(1, 3) = "色"
Result(1, 4) = "サイズ"
Result(1, 5) = "JANコード"
Dim r As Long, c As Long
Dim rr As Long
rr = 2
For r = 2 To UBound(tbl, 1)
For c = 4 To 22 Step 2
If tbl(r, c) <> "" Then
Result(rr, 1) = tbl(r, 1)
Result(rr, 2) = tbl(r, 2)
Result(rr, 3) = tbl(r, 3)
Result(rr, 4) = tbl(r, c)
Result(rr, 5) = tbl(r, c + 1)
rr = rr + 1
End If
Next c
Next r
With Sheets.Add(after:=Sheets(Sheets.Count))
.Range("A1:E1").Resize(UBound(Result, 1)) = Result
Range("a1:a1000").NumberFormatLocal = "00000000"
Range("e1:e1000").NumberFormatLocal = "0000000000000"
End With
End Sub
御回答いただけますと幸いです。
何卒宜しくお願い致します。
（IKD） 2014/10/16(木) 11:38
実際のデータ見てませんが、セルの書式設定だけ気になります。 A列はコードでしたよね？ 例えばコードが 「012345」だとして、 転記される値は 「12345」になります。 確かに書式設定で「000000」とすれば見た目上「012345」になりますが、内部データは「12345」です。 それで不都合なければよいのですが、検索するときやVLOOKUP等の関数を使うことが前提なら、 考え直す必要があります。
とりあえずそこはいじらないでそのままです。
Sub 横縦つー()
Dim tbl
tbl = Range("AK1", Cells(Rows.Count, "A").End(xlUp)).Value
Dim Result
Result = Range("A1:K1").Value
Result = Application.Transpose(Result)
ReDim Preserve Result(1 To UBound(Result, 1), 1 To UBound(tbl, 1) * 10)
Result = Application.Transpose(Result)
Dim r As Long, c As Long
Dim rr As Long, cc As Long
rr = 2
For r = 2 To UBound(tbl, 1)
For c = 10 To 37 Step 2
If tbl(r, c) <> "" Then
For cc = 1 To 9
Result(rr, cc) = tbl(r, cc)
Next cc
Result(rr, 10) = tbl(r, c)
Result(rr, 11) = tbl(r, c + 1)
rr = rr + 1
End If
Next c
Next r
With Sheets.Add(after:=Sheets(Sheets.Count))
.Range("A1:K1").Resize(UBound(Result, 1)) = Result
.Range("a1:a1000").NumberFormatLocal = "00000000"
.Range("e1:e1000").NumberFormatLocal = "0000000000000"
End With
End Sub
この後夜まで返信できません （稲葉） 2014/10/16(木) 12:16
別案
Sub test()
Dim a, i As Long, ii As Long, iii As Long, w(), x
Const Pref = 3: Rem 前項目の列数
Const Dtl = 2: Rem 詳細項目の列数
a = Cells(1).CurrentRegion.Value
ReDim w(1 To Pref + Dtl)
For i = 1 To UBound(w): w(i) = a(1, i): Next
With CreateObject("System.Collections.ArrayList")
.Add w
For i = 2 To UBound(a, 1)
For ii = 1 To Pref
w(ii) = a(i, ii)
Next
For ii = Pref + 1 To UBound(a, 2) Step Dtl
For iii = Pref + 1 To UBound(w)
w(iii) = a(i, ii + iii - 1 - Pref)
Next
.Add w
Next
Next
Set x = .Clone
End With
With Sheets.Add.Cells(1).Resize(x.Count, UBound(w))
.NumberFormat = "@"
.Value = Application.Index(x.ToArray, 0, 0)
.Columns.AutoFit
End With
End Sub
（seiya） 2014/10/16(木) 13:11
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.