[[20041208152106]] 『2行おきに一定範囲のコピーを繰り返し』(にいな) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『2行おきに一定範囲のコピーを繰り返し』(にいな)
 いつも勉強させていただきありがとうございます。
 自分の技量では解決できないのでお教えください。
 2行おきに数値データの入っている行があり、
 そのデータを1行下のセルに3列前にスライドしてコピーしたいのですが、
 約200行のデータがあるためにVBAで実行したいと思うのですが、どう書いたら良いのか
 お教えください。

    A      B  C  D     E      F      G      H      I      J 
 1 品名               12/1   12/2   12/3   12/4   12/5   12/6
 2 みかん               10     10            10            10
 3         10 10        10            10
 4 りんご                       1      2      3
 5             1  2      3
 6 いちご                                                   1
                                             1
イメージが伝わり難いかもしれませんが、
 E2:J2をB3にコピー
 E4:J4をB5にコピー というのをデータが入っている最終行まで繰り返したいのです。
 数値の入ってる範囲(E:J)は変動しません。実際にはE:CJまでですが。
 Excel2000、Windows2000です。


 VBAじゃありませんが、、、データ範囲を A1〜CJ200 として、

 (1) まず A1:A200 を選択してオートフィルタをオンにする。
 (2) 次にA列のフィルタで「空白セル」を選択する。
 (3) B3:CG200 をドラッグして選択。
 (4) B3がアクティブだと思いますので、そのまま状態で =IF(E2<>"",E2,"") とキーボードを打ち、
     「Ctrlキーを押しながら」Enterキーを押す。
 (5) オートフィルタを解除。
 (6) A1:CG200 を選択してコピー、形式を選択して貼り付け−値を選んで実行。

 これでうまくいきませんか? 但し元の表に計算式があると、(6)の作業で数値に変わってしまうので
 使えませんが。(純丸)

 もう一案。
 間の行が完全に何も入力されていないなら、
 E2からJ** までをコピーして、
 B3に形式を選択して貼り付けから、「演算」の「加算」にチェックしてOKでは?
 (sato) 


 わわわ、、、衝突しました。
 純丸さん、早速の御教授ありがとうございます。
 やってみました。こんな風にも出来るんですね(゚.゚) 覚えておきます。
 しかし、残念ながら今回のは他にも色々とVBAで処理を書いた中に組み込みたい処理の1つなのです。 
 また、初めの説明に書き忘れましたが、最終行は毎回変動してしまいます。
 satoさんのもやってみますね。
 これをマクロの自動記録すればヒントを得れるかも。
 (にいな)


 うっ、こちらも衝突☆! satoさん、なぁるほど。自分のやり方よりはるかに早いですね。こりゃいい方法だ。
 と書こうとしたけどマクロ限定だったんですね。(純丸)

 satoさんに教えて頂いた方法でテストデータはOK!でした。
 マクロの記録もしてたのでこれでいけるかと思ったのですが、
 自分のミスに気付きました(>_<)
 データには数値以外にもアルファベットの記号が付いてる個所があり、
 これらは演算の加算ではコピー出来ないんですね。 (にいな)

 マクロを使うなら、割と単純なコードでできるはずです。
 最初の行をコピーして、次の行にずらして貼り付ける。
 これをデータのある分だけ繰り返せばいいわけです。
 マクロの自動記録では最初の行をコピーすると、
   Range("E2:J2").Select
   Selection.Copy
 のようになりますが、"E2:J2"の部分を変数を使えば繰り返し処理ができます。

    For i = 2 To 10 Step 2
        Range(Cells(i, 5), Cells(i, 10)).Select
        Selection.Copy
        Cells(i + 1, 2).Select
        ActiveSheet.Paste
    Next i

 のようなことでできます。
 上の例は、E2からJ2までをコピーして、それを一行下のB2に貼り付ける。
 つぎにその下の行に移って同じ処理を・・・合計5回繰り返しています。

 回答者の皆さんはいつも難しいコードに挑戦されているので、
 この程度の回答は私のような未熟者に任されているようですね(笑)

 (sato)

 手作業であれば、こんな感じかな?
 @まず、いったん空白行を削除します。
  オートフィルタ>A列で(空白セル)>1行以外の行を全部選択し、
  編集→ジャンプ→「セル選択」→可視セルにチェックで「OK」
  反転している行番号の上で右クリック「行の削除」
 Aオートフィルタを解除
 B作業列(例えばK列)へ連番をふります。
 CE2:J4(コピーしたい行)を選択してコピー、最終行(B5)へ貼付
 D作業列の連番をコピーし、Cで貼り付けたデータの作業列(K列)へ貼付
 E作業列を基準に「昇順」で並び替え
 F作業列を削除
 (代奈)
 おっと、VBAでしたぁ(ーー;)
 朝からぼけぼけ
 これを記録するよりコード書けってことですね。。。
 失礼いたしましたm(__)m

 にいなさん、こんにちは!
もう、解決されましたか?
σ(^◇^;)も少し考えてみました。
あまりいい案じゃないけど、よかったら試してみてください。
最初にEからJ列を下にコピーして左にシフトする操作を記録すると以下の様になりまして
Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2004/12/9  ユーザー名 : SoulMan
'

'

    Range("E2:J2").Select
    Selection.Copy Destination:=Range("E3:J3")
    Range("B3:D3").Select
    Selection.Delete Shift:=xlToLeft
    Range("E4:J4").Select
    Selection.Copy Destination:=Range("E5:J5")
    Range("B5:D5").Select
    Selection.Delete Shift:=xlToLeft
    Range("E6:J6").Select
    Selection.Copy Destination:=Range("E7:J7")
    Range("B7:D7").Select
    Selection.Delete Shift:=xlToLeft
End Sub
それを、少し編集すると以下の様になりました。
このとき下から上にループするのがポイントだと思います。
Sub Macro2()
Dim i As Long
    For i = Range("A65536").End(xlUp).Offset(1).Row To 2 Step -2
        Range("E" & i - 1 & ":J" & i - 1).Copy Destination:=Range("E" & i & ":J" & i)
        Range("B" & i & ":D" & i).Delete Shift:=xlToLeft
    Next
End Sub
これに、
Application.ScreenUpdating=False
で画面の更新を停止したり、RangeをCellsにしてみたりすればいいと思います。
それから、これは全くの余談ですが、
(sato)さんの
 >この程度の回答は私のような未熟者に任されているようですね(笑)
 は、少し寂しく思いました。
問題にも解答にも優劣程度なんてないと思います。
みんなぞれぞれに大問題なんだと思います。
もしも私が質問者でこの様なコメントをされたら、少しショックかな、、っと思いました。
でも、これは私の私的な意見ですからくれぐれも気分を悪くなさらないでくださいね。
ではでは、今後とも、よろしくお願い致します。m(__)m
(SoulMan)

 おっと、失礼!シフトも何もそのままでいいような( ̄□ ̄;)!!
Sub Macro3()
Dim i As Long
    For i = Range("A65536").End(xlUp).Offset(1).Row To 2 Step -2
        Range("E" & i - 1 & ":J" & i - 1).Copy Destination:=Range("B" & i & ":G" & i)
    Next
End Sub
v(=∩_∩=)v
(SoulMan)

 お、お、お、おぉぉぉ。。。
 このように書くのですね。
 と、にいなさんじゃないのに横からごめんなさいm(__)m
 (代奈@お勉強中)
 追伸:
 >この程度の回答は私のような未熟者に任されているようですね(笑)
 む〜ん(>_<)私にとっては高い高い階段となっておりますっっっ
 負けないぞ、っと。
 ふぁいとっ(*^◇^*)


 SoulManさん、貴重なご意見ありがとうございます。
 素直に反省いたします。
 質問者にそんな簡単なこと・・・などという気持ちは微塵もありませんでしたが、
 にいなさんが不快に感じたとしたらお詫び申し上げます。
 (sato)

 ありゃま、ありがとうございます。
えらそぶっちゃってごめんなさいね。この学校がますますよくなるといいですね。
σ(^◇^;)もハッスル♂ハッスル♂します。
ではでは、
(SoulMan)

 >この程度の回答は私のような未熟者に任されているようですね
 > 素直に反省いたします。
 あながちハズレでもなかったりする。
 VBAの回答者を増やすためにも、何でもかんでもすぐに回答するのは
 少し控えようと考えていましたので・・・。
 私的にはタイミングのよいコメントだと思ってた。 
 回答者がたくさんいないと質問掲示板は繁栄しないんですよね〜。
 というわけで、すこし自重気味の  (INA) 


 o(=`・ε・´=)oブーッブーッ!! そのような理由で自重されるのなら、
 私のような未熟な物の書いたコードのあとに、
 ここはこんな風に書いたらこうなんだよってアドバイスも今まで以上に
 ┌|*゚o゚|┘よ┌|*゚0゚|┘ろ┌|*゚-゚|┘し┌|*゚。゚|┘く♪

 そのときにはやさしくしてね♪(*/∇\*)キャ
 (川野鮎太郎)

 >アドバイスも今まで以上に 
   (o^^o)ゞ       

 >やさしくしてね♪(*/∇\*)キャ
  Ψ(`ΦwΦ;)ノ⌒・・・)))●~*                 

     (↑ウソです。INA)

 1日外出して帰ってきてみたらいっぱいの書き込みが・・・
 う、う、う、嬉しいです〜。
 純丸さん、satoさん、代奈さん、SoulManさん、INAさんに川野鮎太郎さんまで、
 皆さんありがとうございます。
 不快に思ったなんてことはこれっぽちもありません。
 私も代奈さんのように勉強するように頑張っていきますので、
 これからもよろしくお願い致します。
 とりあえず、上から順にテストしていきますね。 (にいな)


 私も一案。

 Sub sampel()
 Dim i As Long
    For i = 2 To Range("E65536").End(xlUp).Row Step 2
        Range(Cells(i + 1, 2), Cells(i + 1, 85)).Value = _
        Range(Cells(i, 5), Cells(i, 88)).Value
    Next i
 End Sub

  (INA)

 VBA回答者の先生様方、ありがとうございました。m(__)m
 どのVBAも本番データでの試行に成功しました。
 今までの苦労はなんだったんだろうって〜・・・って感じの速い処理結果に満足です。
 更に完成度の高い資料が出来るように頑張っていきます。
 手作業の手順を教えてくださった回答者の方々もありがとうございました。
 日々の業務で応用させていただきます。  (感涙のにいな)

 うぅ〜〜ん、σ(^◇^;)は基本的にコピーと値とは違うものだと思ってます。
INAさんの例でいうと極端な話こんなことでもいいことになってしまうような???
Option Explicit
Sub てすと()
Dim MyA As Variant
Dim i As Long, n As Long
    With Worksheets("Sheet1")
        MyA = .Range("A1", .Range("A65536").End(xlUp).Offset(1)).Resize(, 10).Value
    End With
    For i = UBound(MyA, 1) To 2 Step -2
        For n = 4 To UBound(MyA, 2)
        MyA(i, n - 3) = MyA(i - 1, n)
        Next
    Next
    Worksheets("Sheet2").Range("A1:A" & UBound(MyA, 1)).Resize(, 10).Value = MyA
End Sub
(SoulMan)


 う〜ん(/-_-\) Manちゃんの最初のコードとINAさんのコードの違い(やり方)が
 良く判らない_/ ̄|○ il||li
 お二人とも必要な行範囲を1行ずつコピーして貼り付けじゃないの?
 もしかして書式の問題かな??
 (川野鮎太郎)

 コピーと値渡しの概念を区別していない方もいますので、
 一案として提示させていただいたまでです。
 >もしかして書式の問題かな??
 そうです。値渡しなので書式はコピーされないです。
 一度、配列変数に入れてから値を渡しているだけなので結果は同じですよ。
 極端な話というより、なんかよけい難しくなっているような・・(^_^;)
   (INA)

 配列変数の使い方の見本としてはコンパクトでいいかも、です。
(みやほりん)


 >コードの違い(やり方)が良く判らない
 こう言ったのは、INAさんのおっしゃるように、コピーと値の関係のことだと判っていて書かせていただきました^^
 ただ、Manちゃんのレスが >極端な話で始まり 難しいコード(配列変数って言うんですね(^_^A;)が
 挙げられたので、多分今回の件ではどちらでも良いようだし、う〜ん(/-_-\)
 Manちゃんのこだわりは何だろうと思った次第です^^
 (Manちゃん、決して悪いようには取らないでね^^v)

 当初の質問でみかん、りんご、バナナの行が数式で返ってきている値だった場合は
 またやり方も変わりますよね。(値として貼り付けて良いのか、数式で貼り付けたいのかなどなど)
 あらら?? バナナは無かった_/ ̄|○ il||li
 何言ってるか判らなくなってきた(^_^A;
 要は時と場合により使い分けが必要ですねってことを言いたかったような気がする(^_^A;
 ※配列変数を覚えたら便利そうですね。
 まだまだ配列数式が限界な(川野鮎太郎)


 >数式で返ってきている値だった場合は またやり方も変わりますよね。
 セルに表示されている文字列であれば、Text プロパティで取得すればよいと思います。
  ・・・  .Value = ・・・ .Text のように。
  (INA)

 おはようございます。
 >※配列変数を覚えたら便利そうですね。
 >まだまだ配列数式が限界な(川野鮎太郎)
 鮎ちゃんなら二三回簡単なコードをそのまま手書きで写したら
 配列変数の使い手になると思いますよぉ
 v(=∩_∩=)v
(SoulMan)


 衝突・・・。Manちゃんおはにょ^^v

 言葉って難しいですね。(^_^A;
 上で書いたのもINAさんや、Manちゃん宛てに意見言ってるつもりじゃないので
 誤解があったらm(._.)m ペコッ
 これを見てる方への参考になればって感じで書いてます。^^

 先ほど言ったのは、こんな意味でした。
 上表でE10の値(りんご)が数式(=Sheet2!B3)の結果として10が返ってきてるような場合
 B3に値として10を持ってくるか、元シート(=Sheet2!B3)が変更になった時点で変わるように
 B3に =E10 のような式を入れるかなど、時と場合によるのかなって意味でした。
 これじゃまた誤解を招くかな?( ̄ー ̄;A アセアセ・・・

 追加:>鮎ちゃんなら二三回簡単なコードをそのまま手書きで写したら
 (・0・。) ほほーっ _〆\(..;) メモメモ
 でも、最近鉛筆持つこと少ないから字を忘れちゃって( ̄ー ̄;A ・・・
 (*'ω'*)......ん? そんなことじゃない??(T▽T)アハハ!
 (川野鮎太郎)

 ちなみに、今更ながらですが、
 こんな方法もありかなと。。。
 >E2:J2をB3にコピー
 >E4:J4をB5にコピー 
 これが、当初の目的に一番近かったりしてぇ???
 もう、いいかな??汗
Option Explicit
Sub てすと()
Dim i As Long
Application.ScreenUpdating = False
    For i = Range("A65536").End(xlUp).Offset(1).Row To 2 Step -2
        Cells(i - 1, 5).Resize(, 6).Copy Destination:=Cells(i, 2)
    Next
Application.ScreenUpdating = True
End Sub
(SoulMan)

 業務に追われているうちに、
 VBA解答頂けた講師の方々が切磋琢磨されていたのに気付かず大変失礼致しました。
 今回のりんごの値は数式の結果ではありません。(ピント外れた記載だったらごめんなさい)
 「コピー」と「値渡し」の概念の区別が判っていないのも私です。
 ※配列変数、配列数式・・・なんだろう? 勉強します。
 SoulManさんの最新提案ものちほど使わせていただきます。ありがとうございました。
 (にいな)

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.