行列の入れ替え

質問

次の処理を行うプログラムを書きたいのですが教えていただけないでしょうか？
(処理)
B列のあるセルの値が2000または2001の場合、当該行のc列からn列までのセルをコピーし、11行を挿入し、行列を入れ替えて貼り付ける。
この処理を繰り返したいです。

　　　　　　　　　　　　(処理前)
A　　B　　C　　D　　E　　F　　G 　　H　　I　　J　　L　　M　　N　　O
1　2000　　1　　2　　3　　4　　5　　6　　7　　8　　9　　10　　11　　12
2
3
4
5
6
7
8
9
10
11

(処理後)
A　　B　　C　　D　　E　　F　　G　　H　　I　　J　　L　　M　　N　　O
1　 2000　 1
2　　　　　　2
3　　　　　　3
4　　　　　　4
5　　　　　　5
6　　　　　　6
7　　　　　　7
8　　　　　　8
9　　　　　　9
10　　　　　10
11　　　　　11
12　　　　　12
13　　　　　13

よろしくお願いします。

回答No.4

ham_kamo · ベストアンサー

あれ、エラーが出ましたか。私のテストデータではエラーが出なかったのですが…。
新しいシートを作成し、ということなので、そのように直してみました。今表示しているシートの右に新しいシートを挿入し、そちらへ転記するようにしています。
これで試してみていただけないでしょうか。

Sub Sample()
　Dim i As Integer, j As Integer
　Dim WS1 As Worksheet, WS2 As Worksheet
　i = 1: j = 1
　Application.ScreenUpdating = False
　Set WS1 = ActiveSheet
　Set WS2 = Worksheets.Add(After:=WS1)
　For i = 1 To WS1.Cells(Rows.Count, "B").End(xlUp).Row
　　WS1.Rows(i).Copy WS2.Rows(j)
　　If WS1.Cells(i, "B").Value = 2000 Or WS1.Cells(i, "B").Value = 2001 Then
　　　WS2.Cells(j, "C").Resize(1, 12).ClearContents
　　　WS1.Cells(i, "C").Resize(1, 12).Copy
　　　WS2.Cells(j, "C").PasteSpecial Transpose:=True
　　　j = j + 12
　　Else
　　　j = j + 1
　　End If
　Next
　Application.CutCopyMode = False
　Application.ScreenUpdating = True
End Sub

お礼

ありがとうございます。おかげで解決できました。

回答No.3

ham_kamo

No.2です。補足拝見しました。
こんな感じでしょうか。希望の動作と異なる場合、マクロでは「元に戻す」ができないので、とりあえず実行する前に、元のシートはコピーしてバックアップをとっておいてください。

Sub Sample()
　Dim i As Integer, j As Integer
　i = 1
　Application.ScreenUpdating = False
　Do Until i > Cells(Rows.Count, "B").End(xlUp).Row
　　If Cells(i, "B").Value = 2000 Or Cells(i, "B").Value = 2001 Then
　　　For j = 1 To 11
　　　　Rows(i + 1).Insert Shift:=xlShiftDown
　　　Next j
　　　Range(Cells(i, "D"), Cells(i, "N")).Copy
　　　Cells(i + 1, "C").PasteSpecial Transpose:=True
　　　Range(Cells(i, "D"), Cells(i, "N")).ClearContents
　　　i = i + 12
　　Else
　　　i = i + 1
　　End If
　Loop
　Application.ScreenUpdating = True
End Sub

お礼

回答いただき、ありがとうございます。
プログラムを実行したところ、既存のデータが壊れるというエラーメッセージが出ました。そのため、新しいシートを作成し、それに貼り付けるようにしたいのですが、どうすればよいでしょうか？
本当にすみません。

回答No.2

ham_kamo

質問文の例ではK列が抜けてO列までになっていますが、これはN列までの間違いですよね。

それから、処理後の例は12行挿入されて1～13がコピーされていますが、これは1～12ということでよいですか？

あと、A列には処理前も処理後も連番で数字が入っていますが、これはROW()などで自動的に行番号が表示されるようになっているのでしょうか。

以上の点を補足していただけますか？

補足

補足します。
・K列が抜けているのは、ミスです。正しくは、c列からN列までです。
・行列の変換で12から13になっているのも、ミスです。正しくは、12です。
・A列の数字ですが、行数を表わすために書きました。実際は、入っていません。
よろしくお願いします。

回答No.1

めとろいと（@naktak）

サンプルは作ってませんが。

前提条件を考えてみましょう。
　・対象行が分かる。（B列の値が2000もしくは2001であった行）
　・置換列が分かる。（C列）
　・置換列数が分かる。
　　分からなくても、ある条件（値が入っていないなど）から
　　置換列の終端を得ることが出来る。

この事から、置換の開始行列が分かります。
そして置換列数分を行に置き換えるのですから、置換後の行は
対象行～対象行＋置換列分だという事が分かります。

それらを取得して置換してあげる処理をfor文で回してあげれば出来ると思います。多分。