VBA セルをダブルクリック→違うセルに値をコピー

注文書を作成しています。

シート1のU4:Y34に商品コードが入っています。
U4:Y34のいずれかのセルをダブルクリックすると
B7にコピーします。
次にまた違うセルをダブルクリックすると
B7にはすでに値が入力されているのでB8へコピーと
順にコピーしたいのです。

かつ、B7～B26→E7～E26→J7～J26→M7～M26→P7～P26と
順にセルを移動させたいのです。

全くの初心者で質問も悪いかと思いますが、どなたか
お教えください。
よろしくお願い致します。

No.1 ベストアンサー 回答者： KenKen_SP 回答日時： 2008/04/01 00:58

こんばんは。

何と無く思いついたものですが一案です。

すみませんが、コメント等を余計に入れておきましたのでコードの解説
等は省略させて下さい。

' // シートモジュール
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

　　Dim rSrc As Range
　　Dim rDst As Range
　　Dim r　　As Range
　　
　　' // マスタ範囲定義
　　Set rSrc = Me.Range("U4:Y34")
　　' // 転記先範囲定義
　　Set rDst = Me.Range("B7:B26,E7:E26,J7:J26,M7:M26,P7:P26")
　　
　　' // Dblクリックされたセルがマスタの範囲か？
　　If Not Intersect(Target, rSrc) Is Nothing Then
　　　　' // 転記先が既に埋まってないか？
　　　　If Application.CountA(rDst) = rDst.Cells.Count Then
　　　　　　' // 埋まっている場合
　　　　　　MsgBox "もう書けないっぽい", vbInformation
　　　　Else
　　　　　　' // (1)とりあえず転記先範囲の先頭セルを転記先に仮設定
　　　　　　Set r = rDst.Cells(1)
　　　　　　' // (2)その他空きセルを探す（空きセルのうち最初のセル）
　　　　　　' // 見つからない場合は、(1)が採用される
　　　　　　On Error Resume Next
　　　　　　Set r = rDst.SpecialCells(xlCellTypeBlanks).Cells(1)
　　　　　　On Error GoTo 0
　　　　　　' // 転記実行
　　　　　　r.Value = Target.Value
　　　　End If
　　　　' // Dblクリックで編集モードになるのをキャンセル
　　　　Cancel = True
　　End If
　　' // 後始末
　　Set rSrc = Nothing
　　Set rDst = Nothing

End Sub

この回答へのお礼

分かりやすくコメント頂き、ありがとうございます。
まだ、何となくしか理解できてない事、申し訳なく思います。
もう少し勉強してすべて理解できるように勉強します。
これで作業が簡素化され、ミスも減ると思います。
本当に助かりました。ありがとうございます。

お礼日時：2008/04/01 22:54

No.2 回答者： imogasi 回答日時： 2008/04/01 11:35

あったら便利な機能ですが、したい課題だけ書いて、基本的に丸投げになっている。

色々勉強してから質問したら。
ーー
必要な要素（小）技術(下記の（１）－（４）など）も捉えられていないようだ。
（１）＞U4:Y34のいずれかの
とダブルクリックしたセルがこの範囲か調べる方法
＃１のご回答にも出ているのが高等な方法です。
素人的には
列がＵからＹ、行が４から３４をＩＦ文でＡＮＤを使い聞く方法もある。
例　部分テスト例
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Target.Column <= Range("Y1").Column And Target.Column >= Range("U1").Column _
And Target.Row <= 34 And Target.Row >= 4 Then
MsgBox "aaa"
End If
End Sub
（２）＞B7にコピーします
はダブルクリックしたセル（「Ｔａｒｇｅｔセルの値をＢ７に代入（＝ターゲットセル）でよいでしょう。Ｂ７が動く・変化するのが難しいが、下記。
（３）＞B7にはすでに値が入力されているのでB8へコピー
その列の、現状の一番下の行を捉える定石がある。その＋１した行
に代入すればよい。
納得のためのテスト例
Sub test01()
d = Range("B1000").End(xlUp).Row
MsgBox d
End Sub
このｄ＋１行に代入すればよい。
（４）B7～B26→E7～E26→J7～J26→M7～M26→P7～P26と
順にセルを移動させたいのです。
（３）の代入を行っていて２６行目になったら、Ｅ，Ｊ，Ｍ列の第７行に行くということか。
３列ごと目に移動しているようにも見えるのだが、Ｇ列はどうなった。飛ばすのか。これ（飛び飛びだと）でむつかしい点が増える。
ーー
この制御をどうするかテスト例
順次一定値だが、決まった範囲に決まった順序（ダブルクリックの順序）で、値をセットしていく
Sub test01()
ca = Array(2, 5, 10, 13, 16, 99) 'B,E,J,M,P列
i = 0
C = ca(i)
r = 7
p1:
If C > 16 Then Exit Sub
d = Cells(1000, C).End(xlUp).Row
If d >= 26 Then
i = i + 1
C = ca(i)
MsgBox C
r = 7
GoTo p1
End If
If d + 1 < 7 Then d = 6
Cells(d + 1, C) = "111"
GoTo p1
End Sub
ーー
これらの要素技術を組み合わせることになるが、参考になるかな。
まあ初心者がやるには難しすぎると思うが。ＶＢＡでも中級の上以上と思うが。

この回答へのお礼

大変丁寧にお答え頂き、ありがとうございます。
初心者なのにもかかわらず、こんな難しいことを
しようとしていたのかと、改めて認識いたしました。
大変申し訳ありません。

お礼日時：2008/04/01 22:49