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

質問

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

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

　　 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分程度ループし続けた後、「初期設定」シートの最終行だけが貼り付けられてしまいました。

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

回答No.7

web2525 · ベストアンサー

質問のマクロの動作だと
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

こんな形

お礼

どこが間違っているのかまで、ご指摘をいただき、ありがとうございました。

回答No.6

Wendy02

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 関数の二種類があります。もちろん、ループで入れ替える方法もあります。

お礼

いろいろとご指摘いただき、ありがとうございました。

「実践の難しさ」を日々実感しているところです。またよろしくお願いします。

回答No.5

mimeu

質問者さんは 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 文にまで挑戦されたのですから
ＶＢＡの参考書を１冊、がんばって読んでみるといいですよ。
（図書館にもあります）
世界が広がりますから。

お礼

「入れ子ループ」についてご指摘いただき、ありがとうございました。

「参考書」は1冊もっていますが、なかなか読み込めていません。
「ここまで足をつっこんだら、一度しっかり勉強してみる」べきですね。

ありがとうございました。

回答No.4

MRT1452

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

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

お礼

ありがとうございました

回答No.3

MRT1452

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

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使ったりとかするけど。

お礼

ありがとうございました

回答No.2

MRT1452

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

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

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

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

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

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

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

お礼

ご指摘のとおり、マクロで登録したものから作っています。

なかなか本格的なところを勉強するところまでいけずに、いつもここのような質問サイトのお世話になって
なんとか乗り切っていました。

他の方からのご指摘もありましたので、もう少し自力でできるように、基礎から勉強してみます。

ありがとうございました。

回答No.1

n-jun

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)

Next

Set r2 = Nothing

一例です。

お礼

迅速にご回答いただき、ありがとうございました。