エクセルを並替えコード変換したものをCSVにしたい

質問

画像のような、取引先別に横長に管理しているデータがあります。
それを取引先の品目ごとに縦に並び替え、
さらに、対応するコードにできるようなマクロを作成したいのですが、
並び替えと、コード変換が上手くいきません。

何か良い方法があれば、ご教授よろしくお願いいたします。

回答No.5

tsubuyuki

> それを取引先の品目ごとに縦に並び替え、
> さらに、対応するコードにできるようなマクロを作成したいのですが、
> 並び替えと、コード変換が上手くいきません。

つまり、
「構想以外は何もできていないから作ってくれ」
という事ですね（笑）。

さておき。
ピボットテーブルの逆の発想ですね。
逆の順番（下から上へ）でピボットテーブルを作るのは簡単なんですけどね。

単純に出来るように書いてみました。
が、内容が解らず、メンテナンスが困難だと思ったら、
マクロは使わない方が無難です。
とらぶった時やレイアウトが変わった時に触れないと意味が無いですから。

条件として
・「集計表」シート（元のシート）はＡ１セルから表が始まっていること
・「コード」シートには、
　　　Ａ：Ｂセルに取引先コード表（Ａ列にコード、Ｂ列に名前）
　　　Ｄ：Ｅセルに商品コード表（Ｄ列にコード、Ｅ列に商品名）
　をそれぞれ用意すること
・↑の取引先名称・商品名は空白（スペース）も含めて一字一句相違が無いこと
が現状のコードの「最低条件」です。
エラー処理を全く考慮していないので、
これらの条件を守られていないとエラーで止まります。

これらの条件をクリアすると、データを加工し、並べ替え、ＣＳＶファイル作成まで
一気に終わらせることが可能です。

ちなみに、縦１００件・横５０件＝５０００件のデータで１０秒ほどかかってしまいます。

Sub test()
Dim ASH As Worksheet, BSH As Worksheet, CSH As Worksheet
Dim i As Long, j As Long, k As Long

Application.DisplayAlerts = False
For Each BSH In Worksheets
If BSH.Name = "リスト" Then
BSH.Delete
End If
Next

Set ASH = Worksheets("集計")
Set BSH = Worksheets.Add(after:=Worksheets(Worksheets.Count))
BSH.Name = "リスト"
Set CSH = Worksheets("コード")
k = 1

For i = 2 To ASH.Cells(ASH.Rows.Count, 1).End(xlUp).Row
For j = 2 To ASH.Cells(1, ASH.Columns.Count).End(xlToRight).Column
If ASH.Cells(i, j) > 0 Then
BSH.Cells(k, 1) = ASH.Cells(i, 1)
BSH.Cells(k, 2) = ASH.Cells(1, j)
BSH.Cells(k, 3) = ASH.Cells(i, j)
k = k + 1
End If
Next
Next

With BSH
.Activate
For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
CSH.Activate
.Cells(i, 1) = CSH.Cells(Range("B:B").Find(what:=.Cells(i, 1).Value, lookat:=xlPart).Row, 1)
.Cells(i, 2) = CSH.Cells(Range("E:E").Find(what:=.Cells(i, 2).Value, lookat:=xlPart).Row, 4)
Next
End With

With BSH
.Activate
.Sort.SortFields.Add Key:=Range("A:A"), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("B:B"), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
With .Sort
.SetRange Range("A1", Range("A1").SpecialCells(xlLastCell))
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With

ActiveWorkbook.SaveAs Filename:="c:\共有用\リスト.csv", _
FileFormat:=xlCSV, _
CreateBackup:=False

Set ASH = Nothing: Set BSH = Nothing: Set CSH = Nothing
Application.DisplayAlerts = True
End Sub

繰り返しますが、メンテナンス出来そうにないなら使わない方が無難です。
万が一データが壊れても私は責任を取れませんので。

回答No.4

tom04

こんにちは！
元データはSheet1にあり、B1セル以降右側に品目が列挙、A2セル以降2行目から取引先があるとします。
Sheet2にSheet1の単なる並び替え、Sheet3にSheet2のコード表示
としての一例です。

Alt＋F11キー　→　メニュー　→　標準モジュール　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() 'この行から
Dim i As Long, j As Long
Dim wS1 As Worksheet, wS2 As Worksheet, wS3 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
Set wS3 = Worksheets("Sheet3")
Application.ScreenUpdating = False
wS2.Cells.ClearContents
wS3.Cells.ClearContents
With wS2.Cells(1, 1)
.Value = "取引先"
.Offset(, 1) = "品目"
.Offset(, 2) = "数量"
End With
For i = 2 To wS1.Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To wS1.Cells(i, Columns.Count).End(xlToLeft).Column
With wS2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
.Value = wS1.Cells(i, 1)
.Offset(, 1) = wS1.Cells(1, j)
.Offset(, 2) = wS1.Cells(i, j)
End With
Next j
Next i
wS2.Cells.Copy wS3.Cells(1, 1)
With wS3.Cells(1, 1)
.Value = "取引先コード"
.Offset(, 1) = "品目コード"
End With
For i = 2 To wS3.Cells(Rows.Count, 1).End(xlUp).Row
With wS3.Cells(i, 1)
If .Value = "取引先A" Then
.Value = "A000"
Else
.Value = "B001"
End If
.Offset(, 1) = Replace(.Offset(, 1), "品目", "1000")
End With
Next i
Application.ScreenUpdating = True
End Sub 'この行まで

※　コード表示については質問通り2種類だけしか考慮していません。
仮にもっとデータがある場合はコード表を作成し、それを参考にしなければなりません。

この程度ですが参考になりますかね？m（_ _）m

回答No.3

KURUMITO

取引先や品目に対応したコードの表が別に用意されているとして説明します。
初めの表がシート１に有るとしてA１セルは空白の状態でお示しのようにあるとします。
そこでシート２には並び替えた表を表示させるとしたら例えばA２セルに次の式を入力してC２セルまで横にドラッグコピーしたのちに下方にもドラッグコピーします。

=IF(ROW(A1)>COUNTIF(Sheet1!$A:$A,"?*")*5,"",IF(COLUMN(A1)=1,INDEX(Sheet1!$A:$A,ROUNDUP(ROW(A1)/5,0)+1),IF(COLUMN(A1)=2,INDEX(Sheet1!$1:$1,MOD(ROW(A1)-1,5)+2),IF(COLUMN(A1)=3,INDEX(Sheet1!$B:$F,ROUNDUP(ROW(A1)/5,0)+1,MOD(ROW(A1)-1,5)+1),""))))

これで並べ替えを行った表が表示されます。
コードの表にするためにはシート３にコードの表が有るとします。
A列には取引先名が例えば取引先Aのように、B列には対応するコード番号が例えばA１００のように、また、C列には品目名が、D列には対応するコード番号がそれぞれ入力されているとします。

そこでコードに変換した表ですがシート２のE列からG列に表示させるとしたらシート２のD２セルには次の式を入力してG２セルまでドラッグコピーしたのちに下方にもドラッグコピーします。

=IF($A2="","",IF(COLUMN(A1)=1,VLOOKUP($A2,Sheet3!$A:$B,2,FALSE),IF(COLUMN(A1)=2,VLOOKUP($B2,Sheet3!$C:$D,2,FALSE),IF(COLUMN(A1)=3,$C2,""))))

回答No.2

noname#192382

並べ替えは次のマクロをコピーして使ってください。コード変換は並べ替えの前に実行するのがよいです。
Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2013/1/31 ユーザー名 :
'

'
Dim mygyos1 As Integer, mygyos2 As Integer, myretus1 As Integer, i As Integer
For mygyos1 = 2 To Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

mygyos2 = (mygyos1 - 2) * 5 + 1
myretus1 = 2

For i = 1 To 5
Sheets("Sheet2").Cells(mygyos2, 1) = Sheets("Sheet1").Cells(mygyos1, 1)
Sheets("Sheet2").Cells(mygyos2, 2) = Sheets("Sheet1").Cells(1, myretus1)
Sheets("Sheet2").Cells(mygyos2, 3) = Sheets("Sheet1").Cells(mygyos1, myretus1)

mygyos2 = mygyos2 + 1
myretus1 = myretus1 + 1

Next

Next

MsgBox (Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row)

End Sub

回答No.1

KURUMITO

コードでB００１となっているのになぜA０００なのですか？

補足

判りづらくてすいません。

取引先AのコードがA000
取引先BのコードがB001

になります。