エクセルのマクロ中で

質問

飛び飛び（ctrl＋クリック）で選択された値を
別シートに貼り付けるマクロを作成中です。

　元はD列にある値なのでRange("D" & cnt)として
（cntは変数）

　cnt = Selection.Row.Countで行番号を取得しようと
しましたがうまくいきません。

D1から順番に縦方向に最終データまでは行けるのですが
・・・

　初心者に「産毛」が生えたくらいです。ご教授お願いします

回答No.9

hana-hana3 · ベストアンサー

Sub sample5()

Dim r As Range
Dim Ary As Variant
Dim sh As Integer, i As Integer

'記入したいシート名を、記入順に書く
Ary = Array("データシート", "整理後", "整理後")

sh = LBound(Ary)

i = 8
For Each r In Selection

Worksheets(Ary(sh)).Range("E" & i) = r

If i = 26 Then
i = 8 '記入位置の初期化
sh = sh + 1 'シート名のカウントアップ
If sh > UBound(Ary) Then Exit For
Else
i = i + 2
End If

Next

End Sub

で、どうかな？
転記をするには、
１．どのシートからどのシートへ転記するか？
２．元のデータをどう取得するか？
３．転記位置をどう指定するか？
を、きちんと分けて考えて、実現可能な順番や手法を考えて纏めなくてはいけません。

自分で作ったサンプルを書いてくれるのは嬉しいですが、質問文やプログラムから「前提条件」が読みとれない場合、質問された部分に付いての回答しかできませんからね。

これからもがんばってくださいね。
下記サイトがいろいろと参考になると思いますよ。

参考URL：

http://www.asahi-net.or.jp/~ef2o-inue/index.html,http://www.moug.net/index.htm

お礼

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

質問の仕方については「すみませんでした」の一言に尽きると思います。

お二方のサンプルは両方試してみます。
短時間でこのようなサンプルを作れるスキルには
驚愕の思いです。

自学自習ですのでまたこのような質問をするかと
思いますがそのときはひとつよろしくお願いします。

回答No.8

imogasi

＃７の補足を読んで、当初の質問で無かったことが出てきていますね。質問の表現を考えてもらわないと回答者泣かせですよ。私流にまとめると
（１）元シートのＤ列のセルを範囲指定する。ＣＴＲＬキーを押して範囲指定するので、飛び飛びの範囲を指定することもあり得る。
（２）これを他のシートのＥ１：Ｅ３２に詰めて貼りつける（セルにデータをセット）するが、一杯になると、別シートのＥ１：Ｅ３２にデータをセットし、オーバーしたら
別シートに順次繰り返す。
＞Ctrl＋Shiftで選択し
この意味はなんですか？ＣＴＲＬキーだけでは。
-------
（１）元シートで、ＣＴＲＬうお押して選択するので
Dim cl As Range
For Each cl In Selection
'(処理）
Next
をぜひ使いたい。
＞cnt = Selection.Row.Countで行番号を取得しようと
しましたがうまくいきません。
ややこしい道に入ってしまう。
（２）しかし「処理」の中で、１シートでオーバーフローしたら、シートを別のシートに行かなければならない
。その時も
Dim sh As Worksheet
For Each sh In ActiveWorksheet.Worksheets
'(処理）
Next
を使いたいが、
For Each は「ネスト使用はできない」。
（３）それでシートのIndexを使う。
－－－－－私流のコードをご参考に
MsgBoxは確認用で、適宜削除してください。
Sub test01()
Dim cl As Range
s = 1 'シートのインデックス
i = 1 '第１行目
sc = Sheets.Count: MsgBox sc
ms = Worksheets("Sheet1").Index: MsgBox ms
cnt = Selection.Rows.Count: MsgBox cnt
For Each cl In Selection
If s = ms Then
s = s + 1 '次は、次のシートに
i = 1 '次は、次のシートの第１行目に
End If
Worksheets(s).Cells(i, "E") = cl
i = i + 1 '次は、Ｅ列次行へセット
If i > 32 Then
s = s + 1 '次は、次のシートに
i = 1 '次は、次のシートの第１行目に
End If
Next
End Sub
簡単なテストは済み。
シートセット順序はシートタブの左から。
これを変えるならＶＢＡで変える方法もあります（略）。
取りあえず手動で良いように並べてください。
元シートはＳｈｅｅｔ１と仮定。適宜修正のこと。
元シートは一番左がよいかな。中間でも可と思うが。
元シートをアクチブにしてＶＢＡを実行のこと。
sc*32>cntなどのチェックは省略してます。

お礼

おかげさまで何とかなりました

何度も何度もすみませんでした。

当初は自分の書いたマクロの足りないところを
埋めたくて質問させていただきました。
すべてを頼るのは今後の勉強にならないのでは？という
気持ちがあったからです。結果皆さんを混乱させたことをお詫びします。
まだまだ実務レベルには到底届きませんがお二人の
サンプルを参考にしてやっとおもしろくなったマクロを
極めたいと思います（無理かなぁｗ）

回答No.7

hana-hana3

＞For Each ws In Worksheets
If (ws.Name <> "データシート") And ～

ＡｎｄではＩｆ文全体の条件が成立しません。
ws.Name で得られるのは、for Each ループ１回で１つの名前だけです。
なので、複数の ws.Name が書かれていても、全ての値は同じワークシート名になります。

And ではなく Or にする必要があるかと思います。

前提が解りませんが・・・(ws.Name = "データシート") にして、実行したいシート名の方が良いかと思います。

ＸＸ以外なら実行～と指定するのと、○○なら実行～と指定する場合、どちらの方が数が少ないのでしょう？

補足

重ね重ねすみません。

話を整理します。

データシートの「D列」にあるデータをCtrl＋Shiftで
選択し、それを「あ」シートのRange("E" & i) から
一行おきに（"E"&32)間に貼り付けデータ数が（"E"&32)を
越えた場合、次の「い」シートのRange("E" & i)へ・・・

Ctrl＋Shiftで選択したデータがなくなったら終了。
貼り付けたくないシートがあるので
If (ws.Name <> "データシート") で除外しようと思ったのですが。。。。

回答No.6

hana-hana3

Sub sample3()
Dim r As Range
Dim ws As Worksheet, i As Integer

For Each ws In Worksheets
If (ws.Name <> "データシート") Then

i = 14
For Each r In Selection.Areas

ws.Range("E" & i) = Worksheets("データシート").Range("D" & r.Row)

If i = 32 Then
Exit For
Else
i = i + 2
End If

Next

End If
Next

End Sub

一部誤りがありましたので修正します。

＞For i = 14 To 32を満たすまで
とは、下記の形式ですか？
For i=14 ～　記入場所を指定
For Each ～　全ての指定範囲を取り出す
Next
Next

つまり、指定された記入場所(i)に全ての指定範囲の値(r.row)を書き込んで終了します。
つまり、セルに残るのは最後に取り出された範囲の値になります。

For Each 文は、１．２．３．４．５～と連続で値を取り出す事が可能ですが、３で抜けて再度ループに入っても、次回も１．２．３．４～と同じ順番で取り出す事しかできません。
４から取り出すなら、変数に３を格納し、ｉｆ文で判定する必要があります。
（実行速度の無駄になりますが・・・。）

なので、途中で抜ける場合は「目的の処理が終わった時」にするのがベストだと思います。
つまり、今回のようにループ中に　For Each 文を入れた場合、目的とする処理結果を得ることはできません。

お礼

たびたびありがとうございます。

ん～～時間掛けて理解してもいいですか(^_^;

「言葉」をマクロに翻訳するのはなかなか難しい
ですね。

回答No.5

imogasi

#3です。
Sheet1と同じ位置のセルにコピーしたい場合
Sub test01()
Dim cl As Range
For Each cl In Selection
r = cl.Row
c = cl.Column
Worksheets("sheet2").Cells(r, c) = cl
Next
End Sub
で良いはず。これをボタンのクリックイベントプロシジュアにすれば良い。
補足の件はなんか難しくしているように見える。
Selection.AreasにしなくてもSelectionで良いのでは。
E14以下にもって来たいなら、
＃３を
Sub test02()
Dim cl As Range
i = 14
For Each cl In Selection
Worksheets("sheet2").Cells(i, "E") = cl
i = i + 1
Next
End Sub
に改めればよい。

お礼

回答ありがとうございます。

なるほど。。。っていうほどまだ精通してませんが

じっくり読み砕いて理解していきたいと思います。

しかし色々なアプローチの仕方があるんですね。。。

スゴイの一言。

補足

試してみましたー

For Each ws In Worksheets
If (ws.Name <> "データシート") And (ws.Name <> "整理後") And (ws.Name <> "リスト") Then
For i = 8 To 26 Step 2

この部分書き足したいんですがどうすればいいんでしょう(泣)

自分で色々試したんですが全然駄目で泣きそうです。

回答No.4

hana-hana3

Sub sample2()
Dim r As Range
Dim ws As Worksheet, i As Integer

For Each ws In Worksheets
If (ws.Name <> "データシート") Then

i = 14

For Each r In Selection.Areas

ws.Range("E" & i) = Worksheets("データシート").Range("D" & r.Row)

i = i + 1

Next

End If
Next

End Sub

＞'このiが駄目らしい

For i=14 ～
For Each ～
Next
Next

にしないと、ｆｏｒループが閉じないからです。
前のままだと、ws.Range("E" & i) に同じ値が記入されるだけで意味のないループになっています。

補足

ありがとうございます。
もうひとつだけ教えてください。

上記マクロを実行したところ
For i = 14 To 32を満たすまで
同じものが何度もペーストされます。

で、「Selection.Areas.Count」回だけで
抜けたいのですが。。。。

図々しくてすみません

回答No.3

imogasi

飛び飛びのセルをCopyできないようだから、
＞別シートに貼り付ける
どう貼りつけるのかハッキリしないが、列方向にでよければ
Sub test01()
Dim cl As Range
i = 1
For Each cl In Selection
Worksheets("sheet2").Cells(i, "A") = cl
i = i + 1
Next
End Sub
では駄目ですか。

補足

まずはありがとうございます。で、こんな感じにしたんですがコンパイルエラーが・・・

Dim r As Range
Dim ws As Worksheet, i As Integer

For Each ws In Worksheets
If (ws.Name <> "データシート")Then

For i = 14 To 32 Step 2

For Each r In Selection.Areas

ws.Range("E" & i) = Worksheets("データシート").Range("D" & r.Row)

Exit For

Next i　'このiが駄目らしい

End If
Next ws

End Sub

Next で指定された変数の参照が不正です

回答No.2

hana-hana3

Sub sample()

Dim r As Range

MsgBox "選択数は" & Selection.Areas.Count

For Each r In Selection.Areas
MsgBox r.Row
Next

End Sub

ｆｏｒ文の中で処理してください。
Shift で連続選択した場合は、「選択範囲の数」は１つとして処理されるので、「選択行」すべての値は取得できません。

回答No.1

marbin

ちょっと回りくどいですが、

********************
Sub SENTAKUHANNI()
Range("D1").Value = Selection.Address(0, 0)
End Sub
********************

こういう感じで選択セルのデータをシートに転記し、
転記したデータをカンマでデータの「区切り位置」
で分割し、
出来たセルアドレスでループさせる、ではいかが？