[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『横に続いているデータを縦に変換したいです。』(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.