エクセルVBAのイベントで質問です。

質問

ダブルクリックイベントで、G12:G31の範囲の文字列をB10:B27の範囲(最下行)に入れていくものを使っていますが、新たにH12:H31にある文字列もダブルクリックするとC10:C27の範囲(最下行)に入れていけるようにしたいと思います。

どのようにすればいいでしょうか。
ご存知の方いらっしゃればお教えいただけると助かります。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, _
Cancel As Boolean)
Dim i As Long
Dim flg As Boolean

If Intersect(Target, Range("G12:G31")) Is Nothing Then Exit Sub

If IsEmpty(Target.Value) Then Exit Sub
With Worksheets("シートＡ")
For i = 10 To 27
If .Range("B" & i).Value = "" Then
.Range("B" & i).Value = Target.Value
flg = True
Exit For
End If
Next i
If flg = False Then
MsgBox .Name & " がいっぱいです。"
End If
End With
Cancel = True

End Sub

回答No.2

keithin · ベストアンサー

隣り合ったセル範囲から隣り合ったセル範囲への転記ですから，そんなに手の込んだことをするまでも無さそうです。

作成例：
private sub worksheet_beforedoubleclick(byval Target as excel.range, cancel as boolean)
　dim d as range

　if application.intersect(range("G12:H31"), target) is nothing then exit sub
　if target = "" then exit sub

　set d = cells(10, target.column - 5).resize(18, 1)
　if application.counta(d) = 18 then
　　msgbox "onaka ippai"
　　exit sub
　end if

　d.specialcells(xlcelltypeblanks).cells(1).value = target.value
　cancel = true
end sub

＃目的のセル範囲（B10:B27，C10:C27）に，絶対に間違いなく必ず上から詰めてデータを入れるのか，途中が中抜けになってる場合もあり得ると考えて準備しておくのかによって，転記先を拾うシクミが色々変わります。

お礼

keithinさんありがとうございました。
うごきました！親切にありがとうこざいました。

回答No.1

imogasi

どの範囲をダブルクリックしたら、処理のきっかけにするのか？
コードを見ると、Range("G12:G31") 　　のどれかのセルになっている。はっきり質問に書くこと。
ーー
同じく、新たにH12:H31にある文字列(=１セルで）も、ダブルクリックすると処理をするのだね。
文字列というチェックはいらないのだろう。
全体的に、質問掲出上記のコードに続けて、同じような処理を続ければ良いのでは。
どういう点のために質問しているのかな。
本件は、トリガーの察知などの部分を無理に１つにしても、処理は別なのでメリットは出ないのではと思う。
ーー
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
はセルのダブルクリックと競合して余りよくないのでは。
ーー
質問で追加された部分は下記でどうですか。
IsEmpty(Target.Value)や
If .Range("B" & i).Value = "" Then
は必要ですか。
If flg = False Thenは必要ですか。何をやっているのかな。
ーーー
質問のＣａｎｃｅｌ＝ＴｒｕｅのあとにＩｆーＥｎｄＩｆ部分を入れる。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("H12:H31")) Is Nothing Then
x = Range("H12:H31")
Range("C10:C27") = x
End If
End Sub

補足

いまひとつわかりませんでした。