[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『マクロで任意列まで行ったら3つ下の行へ移動』(ナナシ)
こんにちは。マクロ初心者です。
エラーは出ないのですが、思うような動きをしないため質問させて頂きます。
シート1にはA列に張り付けたいセルが並んでいます。
シート2にシート1を張り付けて行きたいです。
シート2の48列までコピーをしたら6行下の列へ移動し、また続きをコピーしていく。という流れをしたいのですが、うまくいきません。
修正等、ご教示をお願いします。
Sub macro1()
Dim name As String
With Sheets("シート2")
i = 3
M = 3
For N = 1 To Worksheets("シート1").Cells(1, 1).End(xlDown).Row
If .Cells(i, 48) = neme Then
name = Sheets("シート1").Cells(N, 1)
.Cells(i, M) = name .Cells(i, M + 3) = name .Cells(i + 3, M) = name .Cells(i + 3, M + 3) = name
M = M + 6
End If
Next N
End With
MsgBox "終了"
End Sub
< 使用 Excel:Excel2016、使用 OS:Windows7 >
>For N = 1 To Worksheets("シート1").Cells(1, 1).End(xlDown).Row > If .Cells(i, 48) = neme Then > name = Sheets("シート1").Cells(N, 1) ←これ、ForとIfの間では。 (BJ) 2018/06/21(木) 21:24
Sub macro1整理() Dim name As String
Dim M As Long, N As Long '←変数はちゃんと宣言することを推奨 '※「i」は3を代入してから一度も変更していないので定数扱いとした
With Sheets("シート2") M = 3
For N = 1 To Worksheets("シート1").Cells(1, 1).End(xlDown).Row If .Cells(3, 48).Value = name Then '(★)
name = Sheets("シート1").Cells(N, 1).Value Union(.Cells(3, M), .Cells(3, M + 3), .Cells(6, M), .Cells(6, M + 3)) .Value = name
M = M + 6 End If Next N End With
MsgBox "終了" End Sub
BJさんのおっしゃるとおり、記述位置が間違っているなら修正すればいいだけですけど、そうじゃなくて記述はあってるということならば、★のところについて、このままだと少なくとも1回目のループの時は、シート2の【AV3】セルが、文字数0の文字列の時だけ処理するという意味になっちゃうとおもいますけど、想定通りなんでしょうか?
さらにいえば、「neme」と「name」が意図してるのかわからないけど違ってますよね。
単純なタイプミスであれば、↓を読んでみてください。
http://officetanaka.net/excel/vba/beginner/11.htm
http://officetanaka.net/excel/vba/beginner/06.htm
ちなみに質問文(とコードから)やりたいことが読み取れなかったんですが、
シート1のA1 → シート2のA3,D3,A6,D6
シート1のA2 → シート2のG3,J3,G6,J6
・
・
・
シート1のA9 → シート2のAQ3,AT3,AQ6,AT6
の次が、
シート1のA10 → シート2のA9,D9,A12,D12
シート1のA11 → シート2のG9,J9,G12,J12
ってやりたいってことでしょうか?
とりあえず確認まで。
(もこな2) 2018/06/21(木) 22:46
タイプミスについて気づきませんでした。
初歩的な間違いで大変恥ずかしいです。見つけてくださりありがとうございます。
説明が下手で申し訳ありません。
最終的に
シート1(A1)→シート2(C3,G3)
シート1(A2)→シート2(J3,M3)
・
・
・
シート1(A9)→シート2(C6,G6)
シート1(A10)→シート2(J6,M6)
.
.
.
という形にしたいです。
ご教示よろしくお願いします。
(ナナシ) 2018/06/21(木) 23:08
Dim rngFrom As Range Dim rngTo As Range Dim c As Range Dim ixRow As Long Dim ixCol As Long
With Worksheets("シート1").Range("A1") Set rngFrom = .Range(.Cells, .End(xlDown)) End With Set rngTo = Sheets("シート2").Range("A1")
ixRow = -3 For Each c In rngFrom '列インデックスが規定範囲外なら変数を初期化(最初は0だから、初期化作業が必ずされれる) If ixCol < 3 Or ixCol > 48 Then ixCol = 3 ixRow = ixRow + 6 '行番号を6つ増やす(最初は-3+6=3?) End If
'値の転記 With rngTo(ixRow, ixCol) Union(.Cells, .Offset(, 4)).Value = c.Value End With
'次の列番号(7列右に移動?) ixCol = ixCol + 8 Next End Sub
こういうことかな?
(まっつわん) 2018/06/22(金) 08:44
頂いたマクロを動かしてみましたところ、理想の動き方に近く、大変参考になりました。
ただ私のわがままなのですが、最初に入力したマクロの形をあまり変えないまま修正を行いたいと思っております。
皆様から頂いたアドバイスを元に、格闘したいと思っております。
もしよろしければ引き続き、ご教示のほどよろしくお願いします。
(ナナシ) 2018/06/22(金) 09:14
>最初に入力したマクロの形をあまり変えないまま修正を行いたい Sub macro2() Dim name As String Dim i As Long '書き込み先行番号 Dim M As Long '書き込み先列番号 Dim N As Long '読み取り元行番号
i = -3 For N = 1 To Sheets("シート1").Cells(1, 1).End(xlDown).Row name = Sheets("シート1").Cells(N, 1)
'変数の初期化 If M < 3 Or M > 48 Then M = 3 i = i + 6 End If
'転記 With Sheets("シート2").Cells(i, M) Union(.Cells(1, 1), .Cells(1, 3), Cells(3, 1), .Cells(3, 3)).Value = name End With
'次の列番号 M = M + 6 Next MsgBox "終了" End Sub
こういうことですかね^^;;
(まっつわん) 2018/06/22(金) 11:03
先ほどのマクロよりも理想に近く、大変参考になりました。
わがままを言って申し訳ありません。お手数をおかけしました。
ここからは試行錯誤し、マクロを書いていきます。
またわからないことがあれば質問したいと思います。
ありがとうございました。
(ナナシ) 2018/06/22(金) 11:15
現状
シート1(A1)→シート2(C3,G3)
シート1(A2)→シート2(J3,M3)
・
・
・
シート1(A1)→シート2(C6,G6)
シート1(A2)→シート2(J6,M6)
.
.
.
理想
シート1(A1)→シート2(C3,G3)
シート1(A2)→シート2(J3,M3)
・
・
・
シート1(A9)→シート2(C6,G6)
シート1(A10)→シート2(J6,M6)
.
.
.
Sub macro1()
Dim name As String
Dim N As Long, M As Long, i As Long
With Sheets("シート2")
i = 3
M = 3
For N = 1 To Worksheets("シート1").Cells(1, 1).End(xlDown).Row
If .Cells(i, 48) = neme Then
name = Sheets("シート1").Cells(N, 1)
.Cells(i, M) = name .Cells(i, M + 3) = name
.Cells(i + 3, M) = name .Cells(i + 3, M + 3) = name
M = M + 6
End If
Next N
End With
MsgBox "終了"
End Sub
(ナナシ) 2018/06/22(金) 13:21
もこな2さんの書いたことをよく読んでください。 また、Name プロパティと言うものがあるので、変数名に使うべきではない。 別の名前に変更すること。 (BJ) 2018/06/22(金) 13:29
タイプミスをそのままにしてしまい、大変恥ずかしいです。
If .Cells(i, 48) = "" Then
IF文は↑の様に変更いたしました。
(ナナシ) 2018/06/22(金) 13:36
> '転記 > With Sheets("シート2").Cells(i, M) > Union(.Cells(1, 1), .Cells(1, 3), Cells(3, 1), .Cells(3, 3)).Value = name > End With
↑分かり難かったら行を↓のように分ければいいかな。。。
'転記 With Sheets("シート2").Cells(i, M) .Cells(1, 1).Value = name .Cells(1, 5).Value = name End With
> '次の列番号 > M = M + 6
'次の列番号 M = M + 8
かなー。。。
ステップ実行しながら、ローカルウィンドウで変数の中身を監視し、
変数がどのように変化して欲しいか確認しながら調整してみては?
参考URL>>
http://www.ken3.org/vba/excel-help.html
(まっつわん) 2018/06/22(金) 13:47
Sub macro1()
Dim name As String
i = 3
M = 3
For N = 1 To 158
name = Sheets("シート1").Cells(N, 1)
If M = 51 Then
M = 3 i = i + 3
Sheets("シート2").Cells(i, M) = name Sheets("シート2").Cells(i, M + 3) = name
Else
Sheets("シート2").Cells(i, M) = name Sheets("シート2").Cells(i, M + 3) = name
End If
M = M + 6
Next N
MsgBox "終了"
End Sub
皆様お手数をおかけしました。
ありがとうございました。
(ナナシ) 2018/06/22(金) 20:17
とりあえず完成できたようで何よりです。
ただ、整理をしたとき申し添えればよかったのでしょうけど、特にこだわりが無ければ適宜、インデント(字下げ)をつけられると良いと思います。
特に、条件分岐やループ処理をするようなコードであれば、構造を把握することが重要になってくるので、変数宣言の強制と同じく、今のうちから癖をつけておくことをオススメします。
インデント付け(+ちょっと修正)の例を投稿します
Sub macro1を手直し() Dim MySTR As String '←(BJ) 2018/06/22(金) 13:29を参考 Dim i As Long, m As Long, N As Long '←(もこな2) 2018/06/21(木) 22:46を参考
i = 3 m = 3
For N = 1 To 158 MySTR = Sheets("シート1").Cells(N, 1)
If m = 51 Then m = 3 i = i + 3 End If
'↓IF文の外側にすればThen節とEles節で同じこと書かなくて良い Sheets("シート2").Cells(i, m) = MySTR Sheets("シート2").Cells(i, m + 3) = MySTR
m = m + 6 Next N
MsgBox "終了" End Sub
このほか、お望みの方法については同じ結果になるにしても、いろんなアプローチがあると思います。
・ループをFor〜Nextステートメント から For Each 〜 Next にしてみる
・Offsetプロパティを使ってみる
・変数に格納せず直接Valueプロパティを参照する
・オブジェクト変数を使ってみる ...etc
ですので、余力や興味があればご自身のコードを眺めてみてもっと簡単な書くことができないかな〜なんて考えてみるのも一興かとおもいます。
たとえば、私なら同じ処理でもこんな書き方にします。
Sub 参考() Dim MyRNG As Range, dstRNG As Range Dim 行 As Long, 列 As Long
With Worksheets("シート2") Set dstRNG = Union(.Range("C1"), .Range("F1")) End With
For Each MyRNG In Worksheets("シート1").Range("A1:A158") dstRNG.Offset(行, 列).Value = MyRNG.Value
If 列 = 48 Then 行 = 行 + 1 列 = 0 Else 列 = 列 + 6 End If Next MyRNG
MsgBox "終了" End Sub
(もこな2) 2018/06/22(金) 22:20
Sub 参考2() Dim i As Long
For i = 0 To 157 Step 1 Worksheets("シート2").Range("C1,F1").Offset(i \ 8, (i Mod 8) * 6).Value = _ Worksheets("シート1").Cells(i + 1, "A").Value Next MsgBox "終了" End Sub
(もこな2) 2018/06/23(土) 18:15
理想
シート1(A1)→シート2(C3,G3)
↑であるなら「+3」じゃなくて「+4」じゃないですかね
めちゃくちゃ手抜きですが、↓を実行してみてください
Sub test() Dim i, m
i = 3: m = 3 Debug.Print Worksheets("シート2").Cells(i, m + 3).Address(0, 0) End Sub
また、行などを間違えていたので、(もこな2) 2018/06/23(土) 18:15のコードを修正
Sub 参考2() Dim i As Long For i = 0 To 157 Step 1 Worksheets("シート2").Range("C3,G3").Offset(i \ 8, (i Mod 8) * 6).Value = _ Worksheets("シート1").Cells(i + 1, "A").Value Next MsgBox "終了" End Sub
(もこな2) 2018/06/24(日) 03:14
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.