[[20100512090827]]　『移動の条件』（ごん）　ページの最後に飛ぶ

『移動の条件』（ごん）

[[20100511121656]]　『選択した行をクリア』で、

 純丸さんに教えて頂いたコードを元に応用して見ました。

 選択した行を1行下に移動します。
 もしも その際に選択した行の移動が 22行毎の15行目～18行目に差しかかったら
 Exit Subをしたいです。
 それ以外は、選択した行を1行下に移動

 例えば、10行目～14行目選択した場合　15行目に差しかかるので Exit Sub
　　　　 19行目～20行目選択した場合　22行毎なので、選択した行を1行下に移動
 　　　　30行目～36行目選択した場合　22行毎の15行目～18行目(37行目:40行目）なので
　　　　　　　　　 　　　　　　　　　37行目に差しかかるので Exit Sub
　　　　 43行目～44行目選択した場合　次の22行毎に差しかかるので Exit Sub

 ※ 22行毎の15行目～18行目は、選択移動は、しません。

     With Selection
          Intersect(.EntireRow, Columns("A:H")).Copy .EntireRow.Cells(2, 1)
         .EntireRow.Resize(1, 8).ClearContents
         .Cells(.Rows.Count + 2, 1).EntireRow.Cells(1).Select                            
     End With

 よろしくお願い致します。2003XP

 これで合ってるかしら？
 テスト用にシートをコピーして試してみてください。

  Sub test()
  Dim myRng As Range, a As Long, b As Long
  Set myRng = Application.Intersect(Selection.EntireRow, Columns("A:H"))
  a = myRng.Row Mod 22 Mod 14
  b = (myRng.Row + myRng.Rows.Count - 1) Mod 22 Mod 14
  If a > b Or b = 0 Then Exit Sub
  myRng.Cut myRng.Offset(1)
  End Sub

 （ｍｏｍｏ）

 ｍｏｍｏさん　
　
 完璧です！！！　有り難うございました。
 Cutをすると罫線が消えるので、Copyにし　ClearContentsを入れて、
 ActiveCellを移動元の最初の行Ａにしたいので
 大変恐縮なのですが、ｍｏｍｏさんの　コードをお借りして
 以下のようにしました。
 どうでしょうか？（ごん）

 Sub test2()

   Dim myRng As Range, a As Long, b As Long
    Set myRng = Application.Intersect(Selection.EntireRow, Columns("A:H"))
        a = myRng.Row Mod 22 Mod 14
        b = (myRng.Row + myRng.Rows.Count - 1) Mod 22 Mod 14

      If a > b Or b = 0 Then Exit Sub

         With Selection
              myRng.Copy myRng.Offset(1)
              .EntireRow.Resize(1, 8).ClearContents
              .Cells(.Rows.Count + 2, 1).EntireRow.Cells(1).Select
     End With
 End Sub

 動いていれば大丈夫だと思います。
 ただ、折角myRngにコピー範囲をSetしてるので
 またSelectionを使うのももったいないのかな？と思います。

 参考までにmyRngを変数を使わずにWithステートメントで括ると、
 以下のような感じでも同じ動作になります。

 Sub test2()
 Dim a As Long, b As Long
 With Application.Intersect(Selection.EntireRow, Columns("A:H"))
     a = .Row Mod 22 Mod 14
     b = (.Row + .Rows.Count - 1) Mod 22 Mod 14
     If a > b Or b = 0 Then Exit Sub
     .Copy .Offset(1)
     .Rows(1).ClearContents
     .Cells(1).Offset(.Rows.Count + 1).Select
 End With
 End Sub

 あと、ごんさんのコードですと
 >ActiveCellを移動元の最初の行Ａにしたいので
 が実現されていないのではないですか？
 上の参考コードはそのままにしていますが、もし移動元のA列だとしたら

     .Cells(1).Offset(.Rows.Count + 1).Select

 の部分を

     .Cells(1).Select

 に変更してください。

 （ｍｏｍｏ）

 ｍｏｍｏさん

 >Selectionを使うのももったいないのかな？ 
 ご教示頂けて、本当に勉強になります。

 ありがとうございました♪　（ごん）

コメント返信：

[ 一覧(最新更新順) ]

[[20100512090827]] 『移動の条件』（ごん） ページの最後に飛ぶ

[[20100512090827]]　『移動の条件』（ごん）　ページの最後に飛ぶ