行列入れ替えの並び替えを簡単に出来る方法
エクセルで写真の左側のシートを右側のシートの様に並び替えをしたいのですが、簡単に計算式を入れてやる方法はありますか？
変換前のシートは他にもありまして、行列の長さはどれも長さがバラバラになっております。
行は～◯kgが複数あり、列は商品コードが100個以上あるのもあります。
なので、行列の長さがバラバラでも一つのマクロで動作出来るものを作成したいと考えています。
計算式を一個づつ入れて作ってましたがとんでもなく不格好になり。。。。
すみません、どなたかご指導お願いできませんか？
Sub henkan()
'貼付けシートの作成
'シート名は変換で作成
Sheets.Add after:=ActiveSheet
ActiveSheet.Name = "変換"
'タイトル名作成
Range("A1").Select
ActiveCell.FormulaR1C1 = "商品コード"
Range("B1").Select
ActiveCell.FormulaR1C1 = "容量"
Range("C1").Select
ActiveCell.FormulaR1C1 = "量"
'容量作成
Dim g As Integer
Dim h As Integer
r = 0
Z = 0
y = 0
Worksheets("量").Activate
Range(Cells(3, 3), Cells(3, Columns.Count).End(xlToLeft)).Select
Z = Selection.Count
Worksheets("量").Activate
Range("B4", Range("B4").End(xlDown)).Select
y = Selection.Rows.Count
For g = 4 To y + 3
Worksheets("量").Activate
Range(Cells(3, 3), Cells(3, Columns.Count).End(xlToLeft)).Select
Selection.Copy
h = g - 2 + r 'ここでhの値を計算しています
Sheets("変換").Cells(h, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
r = r + Z - 1
Next g
'量作成
Dim j As Integer
Dim k As Integer
r = 0
For j = 4 To y + 3
Sheets("量").Select
Sheets("量").Range(Cells(j, 3), Cells(j, Columns.Count).End(xlToLeft)).Copy
k = j - 2 + r 'ここでkの値を計算しています
Sheets("変換").Cells(k, 3).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
r = r + Z - 1
Next j
'商品コード作成
Dim l As Integer
Dim m As Integer
r = 0
For l = 4 To y + 3
Worksheets("量").Activate
Cells(l, 2).Select
Selection.Copy
m = l - 2 + r 'ここでmの値を計算しています
Sheets("変換").Cells(m, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
r = r + Z - 1
Next l
'罫線作成
Sheets("変換").Select
With ActiveSheet.UsedRange.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
'容量コードの空白埋め
Sheets("変換").Select
Range("A1").Select
Dim o As String
Dim p As Range
o = "A2:B" & Range("C" & Format(Rows.Count)).End(xlUp).Row
For Each p In Range(o)
If p.Value = "" Then p.Value = p.Offset(-1, 0).Value
Next
Dim rng As Range
Worksheets("変換").Activate
Worksheets("変換").UsedRange.Select
For Each rng In Selection
If rng.Value = "" Then
rng.Value = "0"
End If
Next rng
End Sub
お礼
回答ありがとうございます。 Cell，Cellsは質問を書きもむときにの間違えました。 作業中のExcelではcellsになっていました。 "明細"のシートはほかのBookから移動させてくるものなのでコマンドボタンの設置はできません。 コマンドボタンの設置はあきらめて、案２を参考にし、"明細"のシートを右クリックすると実行するようにしました。