[[20180621204821]]　『マクロで任意列まで行ったら３つ下の行へ移動』（ナナシ）　ページの最後に飛ぶ

『マクロで任意列まで行ったら３つ下の行へ移動』（ナナシ）

こんにちは。マクロ初心者です。
エラーは出ないのですが、思うような動きをしないため質問させて頂きます。

シート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さんのおっしゃるとおり、記述位置が間違っているなら修正すればいいだけですけど、そうじゃなくて記述はあってるということならば、★のところについて、このままだと少なくとも１回目のループの時は、シート2の【AV3】セルが、文字数0の文字列の時だけ処理するという意味になっちゃうとおもいますけど、想定通りなんでしょうか？

さらにいえば、「neme」と「name」が意図してるのかわからないけど違ってますよね。
単純なタイプミスであれば、↓を読んでみてください。
http://officetanaka.net/excel/vba/beginner/11.htm
http://officetanaka.net/excel/vba/beginner/06.htm

ちなみに質問文（とコードから）やりたいことが読み取れなかったんですが、
シート１のA1　→　シート２のA3,D3,A6,D6
シート１のA2　→　シート２のG3,J3,G6,J6
・
・
・
シート１のA9　→　シート２のAQ3,AT3,AQ6,AT6
の次が、
シート１のA10　→　シート２のA9,D9,A12,D12
シート１のA11　→　シート２のG9,J9,G12,J12

ってやりたいってことでしょうか？
とりあえず確認まで。

（もこな２） 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

Sub test()

    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

何度も申し訳ありません。
皆様のアドバイスをもとにマクロを修正していったのですが、結局ふりだしへ戻ってしまいました。
IF文がおかしいのではないと考えているのですが、どう修正したらよいかわからない状態です。

現状

シート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

 もこな２さんの書いたことをよく読んでください。
 また、Name プロパティと言うものがあるので、変数名に使うべきではない。
 別の名前に変更すること。
（BJ） 2018/06/22(金) 13:29

BJ様、返信ありがとうございます。

タイプミスをそのままにしてしまい、大変恥ずかしいです。
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 '←（もこな２） 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

（もこな２） 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

（もこな２） 2018/06/23(土) 18:15

（ナナシ） 2018/06/22(金) 20:17について、気づきの点で。

理想
シート1(A1)→シート2(C3,G3)

↑であるなら「＋３」じゃなくて「＋４」じゃないですかね
めちゃくちゃ手抜きですが、↓を実行してみてください

   Sub test()
      Dim i, m

      i = 3: m = 3
      Debug.Print Worksheets("シート2").Cells(i, m + 3).Address(0, 0)
   End Sub

また、行などを間違えていたので、（もこな２） 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

（もこな２） 2018/06/24(日) 03:14

コメント返信：

[ 一覧(最新更新順) ]

[[20180621204821]] 『マクロで任意列まで行ったら３つ下の行へ移動』（ナナシ） ページの最後に飛ぶ

[[20180621204821]]　『マクロで任意列まで行ったら３つ下の行へ移動』（ナナシ）　ページの最後に飛ぶ