参考資料から転記して利用をしています、限られたことはできるのですが、希望のことが出来ません、お知恵を貸してください。
M10 N10 O10 P10 Q10 R10 各60行までリスト表があります
品名 単価 品名 単価 品名 単価
1、Wクリックで品名をクリックしたとき品名と単価を指定セルへ 転記先A10(品名)C10(単価)
A30までの行間へ順次転記
2、M、O列はA10~A30の行間へ転記
3、Q列はA35~A49の行間へ転記
' // シートモジュール
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("M10:R50")
' // 転記先範囲定義
Set rDst = Me.Range("A10:A49")
' // 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
少しの改良はできますが、込み合ってくると、全然改良できません
よいお知恵をください、お願いいたします。
No.2ベストアンサー
- 回答日時:
#1の回答者です。
もしかして、コードの中で、
LstRw = 35 ' ←ここでは?
↓
LstRw = 31 '修正したらどうでしょう。
A列31から34行までについては、まったく空だと思っていましたが、そんなことはあるわけないですよね。気が付きませんでした。
でも、ダメだったら、全部書き換えます。
ご返事遅れました、テストの結果最高でした、ありがとうございました。
これで作業が軽減されます、大変ありがたく使用します。
これから、細かく検討して何が変われば、どのように記述すれば、勉強してみます。
また、ご教授お願いいたします。
No.1
- 回答日時:
こんにちは。
なかなか、これは難しいですね。
質問のコードを見当し、それを見本にして、一応、書いてみました。
>If Not Intersect(Target, rSrc) Is Nothing Then
これは、誤動作しますので、列番号で決めたほうがよいです。
>2、M、O列はA10~A30の行間へ転記
>3、Q列はA35~A49の行間へ転記
これは、それぞれの範囲が決められているので、それぞれの範囲の空きセルを調べなくてはなりません。
>Set r = rDst.SpecialCells(xlCellTypeBlanks).Cells(1)
空いている所を探す方法よりも、上から下に付け足していく方法を考えました。
そのようにしか考えられませんでした。
ただ一つ、直せないのは、ダブルクリックで、枠線に掛かると、ジャンプが起こることがあるという現象があります。これは、やむを得ません。
以上を元にして試しに書いてみました。
'//
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rSrc As Range: Set rSrc = Range("M10:R50")
Dim r As Range
Dim rw As Long, LstRw As Long
Dim rDst1 As Range: Set rDst1 = Range("A10:A30")
Dim rDst2 As Range: Set rDst2 = Range("A35:A49")
Dim tmpDst As Range
If Intersect(Target, Range("M10:R50")) Is Nothing Then Exit Sub
'条件によって変数の中身が変わる
If Target.Column = 13 Or Target.Column = 15 Then
Set tmpDst = rDst1
LstRw = 35
ElseIf Target.Column = 17 Then
Set tmpDst = rDst2
LstRw = 50
Else
GoTo Endline
End If
'実行
If Application.CountA(tmpDst) = 0 Then
Set r = tmpDst.Cells(1)
Else
If Application.CountA(tmpDst) < tmpDst.Cells.Count Then
Set r = Cells(LstRw, 1).End(xlUp).Offset(1)
Else
MsgBox "もう書けないっぽい", vbExclamation
GoTo Endline
End If
End If
Target.Copy r
Target.Offset(, 1).Copy r.Offset(, 2)
Endline:
Cancel = True
Set rSrc = Nothing
Set rDst1 = Nothing
Set rDst2 = Nothing
End Sub
ありがとうございます。
コピーして試してみました、Q列はA35~A49の行間へ転記は完璧です
M、O列はA10~A30の行間へ転記 はA10一行に転記できますがA2以後は転記しないのですが、何か変えるところか、付記しないといけませんか?
ご指導ください。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 【追加】ファイルを閉じてダイアログで保存した時だけ処理の実行をする 3 2022/03/23 15:43
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Visual Basic(VBA) excel vbaでvlooupの変数がわかりません。 7 2022/05/30 09:35
- Visual Basic(VBA) 前回ご教授いただいたコードに覚えたてのループ処理で品名りんごAから順に20回for nextでループ 7 2023/01/13 22:01
- Visual Basic(VBA) 他のシートからコピーする下記マクロで貼付け位置をWorksheets(1).Range("A3")の 8 2023/01/30 18:48
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- Excel(エクセル) 日付で矢印マクロ 4 2023/07/25 16:47
- Visual Basic(VBA) エクセルVBAのコードで質問です。 下のコードはJ16の文字列をB3を起点とする範囲から探して、見つ 5 2023/04/07 11:07
- Visual Basic(VBA) 【Excel VBA】自動メール送信の機能追加 5 2022/09/29 12:53
- Visual Basic(VBA) VBAが止まります。 3 2022/08/31 14:09
このQ&Aを見た人はこんなQ&Aも見ています
-
プロが教えるわが家の防犯対策術!
ホームセキュリティのプロが、家庭の防犯対策を真剣に考える 2組のご夫婦へ実際の防犯対策術をご紹介!どうすれば家と家族を守れるのかを教えます!
-
VBA セルをダブルクリック→違うセルに値をコピー
Excel(エクセル)
-
エクセル クリックした値を転記
Excel(エクセル)
-
選択したセルでダブルクリックをするとエクセルマクロによりそのセルがコピ
Visual Basic(VBA)
-
-
4
エクセルでセルをダブルクリックしたらそのブックの別のシートに飛ぶ動作
Excel(エクセル)
-
5
エクセルVBAでダブルクリックをしたらA列のデータが別シートに転記されるにはどうしたらよいですか?
Visual Basic(VBA)
-
6
エクセル ダブルクリック入力の範囲が複数の場合
Excel(エクセル)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Sub 要具ライフ() ActiveSheet....
-
ExcelVBAを使って、値...
-
i=cells(Rows.Count, 1)とi=cel...
-
特定のセルが空白だったら、そ...
-
Excelで指定した日付から過去の...
-
【Excel VBA】指定行以降をクリ...
-
Excelのプルダウンで2列分の情...
-
VBAを使用した時間管理
-
エクセル マクロで セルの範...
-
EXCELのVBA-フィルタ抽出後の...
-
EXCELで変数をペーストしたい
-
Excel vbaで特定の文字以外が入...
-
特定の文字を条件に行挿入とそ...
-
DataGridViewの各セル幅を自由...
-
screenupdatingが機能しなくて...
-
【Excel】指定したセルの名前で...
-
VBAでセルに値が入ったときにイ...
-
TODAY()で設定したセルの日付...
-
VBからEXCELのセルの値を取得す...
-
DataGridViewのセル編集完了後...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
ExcelVBAを使って、値...
-
特定のセルが空白だったら、そ...
-
i=cells(Rows.Count, 1)とi=cel...
-
【Excel VBA】指定行以降をクリ...
-
【マクロ】プルダウンが設定し...
-
Excelで指定した日付から過去の...
-
VBA実行後に元のセルに戻りたい
-
【Excel】指定したセルの名前で...
-
Excel vbaで特定の文字以外が入...
-
特定の文字を条件に行挿入とそ...
-
EXCELで変数をペーストしたい
-
【EXCEL VBA】Range("A:A").Fi...
-
エクセルVBAでコピーして順...
-
連続する複数のセル値がすべて0...
-
screenupdatingが機能しなくて...
-
Excel VBA、 別ブックの最終行...
-
任意フォルダから画像をすべて...
-
Excelのプルダウンで2列分の情...
-
【VBA】カーソルのある行の1行...
-
VBAコマンドボタンを押すたびに...
おすすめ情報