初めての店舗開業を成功させよう>>

タイトルが分かり難くてすみません。
教えて頂きたいのは、以下の画像のように変更したいのです。
どのようにするのが最も効率が良いでしょうか?

※実際は商品数やサイズ選択項目が無数にあります。

どうぞ宜しくお願いします。

「行と列の関係性を一括編集」の質問画像

A 回答 (1件)

こんにちは!


↓の画像で左側がSheet1、右側がSheet2とします。
Sheet2の1行目項目は入力済みだとします。

尚、Sheet1のB列以降(サイズ?)は途中に空白セルはない!という前提です。
標準モジュールに↓のコードをコピー&ペーストしてマクロを実行してみてください。

Sub Sample2()
Dim i As Long, startRow As Long, endRow As Long, endCol As Long, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
endRow = wS2.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
If endRow > 1 Then
Range(wS2.Cells(2, "A"), wS2.Cells(endRow, "B")).ClearContents
End If
For i = 1 To wS1.Cells(Rows.Count, "A").End(xlUp).Row
endCol = wS1.Cells(i, Columns.Count).End(xlToLeft).Column
If endCol > 1 Then
Range(wS1.Cells(i, 2), wS1.Cells(i, endCol)).Copy
wS2.Activate
ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteAll, Transpose:=True
startRow = wS2.Cells(Rows.Count, "A").End(xlUp).Row + 1
endRow = wS2.Cells(Rows.Count, "B").End(xlUp).Row
Range(wS2.Cells(startRow, "A"), wS2.Cells(endRow, "A")) = wS1.Cells(i, "A")
End If
Next i
Application.ScreenUpdating = True
End Sub

こんなんではどうでしょうか?m(_ _)m
「行と列の関係性を一括編集」の回答画像1
    • good
    • 0
この回答へのお礼

本当に有難うございます!
理想通りに処理することができました!

これで作業時間が大幅に短縮される上にミスもなくなります。
とても嬉しいです m(_ _)m

お礼日時:2013/12/21 16:21

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


人気Q&Aランキング