エクセルVBA　での繰り返し処理について

Question

以下の作業を２０回繰り返そうとしています（別シートから持ってきた値を「行列を入れ替えて」貼り付け）

Sheets("初期設定").Select
    Range("A6:C6").Select
    Selection.Copy
    Sheets(TS).Select
    Range("B4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True

「初期設定」シートの方は1行ずつ並んでいるので、「2回目」の「2行目」は
　　「 Range("A7:C7").Select」になり、

「TS」シートの20行後に貼り付けたいので、「2回目」の「5行目」は
　　「Range("B24").Select」　になります

これを、for ～　next　を使い、以下のようにしてみましたが、上手くいきません。

For j = 6 To 26
    For k = 4 To 384 Step 20

Sheets("初期設定").Select
    Range(Cells(j, 1), Cells(j, 3)).Select
    Selection.Copy
    
    Sheets(TS).Select
    Cells(k, 2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
  Next k
  Next j

1分程度ループし続けた後、「初期設定」シートの最終行だけが貼り付けられてしまいました。

どこをどのように直せばいいのかお教えください。
よろしくお願いいたします。

web2525 · Accepted Answer

質問のマクロの動作だと
For j = 6 To 26
For k = 4 To 384 Step 20
＜＜処理＞＞
Next k
Next j

j=6の時にk=4 からk=384までの処理を20回繰り返す
j=7の時にk=4 からk=384までの処理を20回繰り返す
・
・
・
j=26の時にk=4 からk=384までの処理を20回繰り返す

行っている処理は
jの範囲のデータをkのセルに貼り付ける

つまり変化しているｊのデーターを毎回ｋのセルに上書きしている状態です
最終的にはｊの最終データで埋め尽くされる形になります

ｊのデータは決まったｋのセルに一度だけ貼り付ければよいわけですからｋのループ自体が必要ないですね

貼り付けるkのセルをｊから求める形式に変えたら解決します

質問のマクロを修正すると

ｒ＝0

For j = 6 To 26

Sheets("初期設定").Range(Cells(j, 1), Cells(j, 3)).Copy

k=j-2+r　'ここでkの値を計算しています

Sheets(TS).Cells(k, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True

r=r+20　'次回のkの位置を20行送るための処理

Next j

こんな形

Wendy02 · Answer

Sub MacroTest1()
'元のマクロを直しました。
Dim j As Long, k As Long
Const TS As String = "TS"
　　k = 4
　　Application.ScreenUpdating = False
　　For j = 6 To 26
　　　　　　With Worksheets("初期設定")
　　　　　　　.Range(.Cells(j, 1), .Cells(j, 3)).Copy
　　　　　　End With
　　　　　　With Worksheets(TS)
　　　　　　　.Cells(k, 2).PasteSpecial Paste:=xlPasteValues, _
　　　　　　　　Operation:=xlNone, _
　　　　　　　　SkipBlanks:=False, _
　　　　　　　　Transpose:=True
　　　　　　End With
　　　　　　k = k + 20
　　　　　　If k > 384 Then Exit For　'?元のコードに疑問がありますが残しました。
　　Next j
　　Application.ScreenUpdating = True
　　Application.CutCopyMode = False
End Sub

'//別の方法

Sub MacroTest2()
　　Dim i As Long, j As Long
　　Dim sh As Worksheet
　　Set sh = Worksheets("TS")
　　j = 4
　　Application.ScreenUpdating = False
　　For i = 6 To 26
　　　　With Worksheets("初期設定")
　　　　　　sh.Cells(j, 2).Resize(3).Value = _
　　　　　　Application.Transpose(.Range(.Cells(i, 1), .Cells(i, 3)).Value)
　　　　　　j = j + 20
　　　　　　''If j > 384 Then Exit For　'コメントブロックを置きました。
　　　　End With
　　Next
　　Application.ScreenUpdating = True
　　Set sh = Nothing
End Sub

'//
Rangeオブジェクトの引数に、初歩的なですが、Range の引数は、オブジェクトも可能です。だから、Cells プロパティでも可能です。ただ、ミスしやすくなります。どちらかとというと、"A" & i スタイルの型のキャストを利用した文字列変換は、可読性は上がりますが、わずかなロスはあります。それは、気にするほどのことはありません。

今回のコードは、入門レベルでは気が付かない点がいくつもありますから、いくつかの人のコードをみて慣れていくしかありません。テキストだけではおぼられない実践のむつかしさだと思います。残念ながら、回答者の方も、どちらかというと、質問を読み解く側の慣れによって違いが出てしまっています。「行列を入れ替え」るテクニックは、ご質問者さんの方法と、Transpose 関数の二種類があります。もちろん、ループで入れ替える方法もあります。

mimeu · Answer

質問者さんは For ～ Next 文を二重につかっておられますが
こういうのを入れ子のループといいます。
そのばあい、 k と j の値がどう変わっていくか、ご自分の頭で考えてください。
＜＜ それがこの問題の鍵です ＞＞

例えば次のプログラムを実行して、 k と j の値を見れば
なぜウマクいかなかったか理解されると思います。

Sub 実験 ()
　　Dim j As Integer, k As Integer
　　For j = 6 To 26
　　　　For k = 4 To 384 Step 20
　　　　　　Debug.Print "k =" ; k ; "  j =" ; j
　　　　Next k
　　Next j
End Sub

なので正解は、ループを入れ子にしないこと。

Sub 正解()
　　Dim j As Integer, k As Integer
　　k = 4
　　For j = 6 To 26
　　　　Worksheets("初期設定").Range("A" & j & ":C" & j).Copy Worksheets("TS").Range("B" & k)
　　　　k = k + 20
　　Next j
End Sub

せっかく For ～ Next 文にまで挑戦されたのですから
ＶＢＡの参考書を１冊、がんばって読んでみるといいですよ。
（図書館にもあります）
世界が広がりますから。

MRT1452 · Answer

修正。
for k = 1 to 95
↓
for k = 1 to 19

基本的なところ間違ってたorz

MRT1452 · Answer

実際に動かしていないので、まともに動かないかもしれませんが、
自分なら

dim j as integer
dim k as integer

for j = 1 to 21
　for k = 1 to 95
　　Worksheets("TS").Cells(((k-1)*20)+4, 2) = Worksheets("初期設定").Cells(j+5, 1)
　　Worksheets("TS").Cells(((k-1)*20)+4, 3) = Worksheets("初期設定").Cells(j+5, 2)
　　Worksheets("TS").Cells(((k-1)*20)+4, 4) = Worksheets("初期設定").Cells(j+5, 3)
　next k
next j

こうするかな。
写すデータが増えるならさらに固定させてる位置の方もループ化するとか。
実際には、20とか固定値はConst使ったりとかするけど。

MRT1452 · Answer

たぶん、マクロの登録で出来たマクロを参考に作っているのだと思うけど、
きちんとしたものを作るならきちんと勉強したほうが良いですよ。

マクロの登録で出来るマクロって、無駄が多いし、汎用的には使えないことが多々あるので。
根本的にこれで出来るマクロは参考にしないこと。

値を別のシートにセットするだけなら、たとえば、

Worksheets("Sheet2").Cells(2, 2) = Worksheets("Sheet1").Cells(1, 1)

こんな感じで書けば1行で済む話だし。
（ループさせるならこれにCells内の行列の指定を算出すれば良いだけ）

今後もプログラムとか組むのであれば、コピペでやるのは良くないです。
（Excelでしか使えない考え方。VBとかになると、この考え方は全く使えない。）
セル1個1個を変数とみなして考えれば良いかと。
また、セルの指定の仕方も、RangeでやるのかCellsでやるのか統一した方が良いです。

まずは根本的なプログラムの基礎を叩き込んだ方が良いです。
ExcelVBAであれば、サンプルはネットを探せばゴロゴロあります。
きちんとしたプログラムの作り方に慣れれば、これがVBになってもJavaになっても基本的な考え方として、融通が利きます。

n-jun · Answer

Dim r1 As Range
Dim r2 As Range

Set r2 = Sheets(TS).Range("B4")

' TSがシート名なら　↑を↓に変更
' Set r2 = Sheets("TS").Range("B4")

For Each r1 In Sheets("初期設定").Range("A6:A25")

r1.Resize(, 3).Copy
r2.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True

Set r2 = r2.Offset(20)

一例です。

エクセルVBA での繰り返し処理について

質問のマクロの動作だと

Sub MacroTest1()

質問者さんは For ～ Next 文を二重につかっておられますが

修正。

実際に動かしていないので、まともに動かないかもしれませんが、

たぶん、マクロの登録で出来たマクロを参考に作っているのだと思うけど、

Dim r1 As Range

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

エクセルVBA　での繰り返し処理について