No.4ベストアンサー
- 回答日時:
またまた登場、myRangeです。
一生懸命やってる人には加勢をせねば。。。(^^;;;
------------------------------------------------------------
(1) ("初期入力")B列の値の入れたいセルを、ダブルクリックし、("Data") を表示。
(2) ("EP63367,EP63381,EP63402,EP63388,EP63395,EP63402")のいずれかをダブルクリックする。
(3) (Data!) (FB63422,FE63422,FJ63422)をコピー。
(4) (3)を(拾い出し!) (AF)に値のみ貼り付け。
(5) (Data) (FP63367:FP63388)をコピー。
(6) (5)を(拾い出し!) (AK)に貼り付け。
(7) (2)でダブルクリックされた値を(初期入力!)で、ダブルクリックされたセルに貼り付け。
上記のような処理だということですが、当方の疑問点に答えてないことがあります。
---------------------------------------------------------------------
(1)Range("FC63364").Activate '有効なデータの入れてないセルに戻す
意味が分かりません。
(2)(Data) (FP63367:FP63388)をコピー
FP列1列コピーなのに、.Resize(1, 5) と5列扱っている
(3)AF,AKの転記開始行のひとつ上のセルには何か入力されているか
転記行を取得するときに問題になる
それからもうひとつ
(4)Range("FP63367:FP63388")をコピーする部分で
If Rng.Value <> "" Then というコードがありますが
これはこれでいいのですですか?
'---------------------------------------------------------------------
で、
疑問点(1)は省略
疑問点(2)~(3)は質問者提示のまま
疑問点(4)は、”ある”ということで
上記(1)~(7)の条件でのコードは以下のようになります。
'------------------------------------------------------------
●標準モジュール(初期入力にDataの値を転記するための変数)
'-------------------------------------------------------------
Public myCell As Range
'--------------------------------------------------------
'●(初期入力)のコード
'---------------------------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column <> 2 Then Exit Sub
Cancel = True
If Target.Value <> "" Then
MsgBox ("値が入っているセルは選べません。")
Exit Sub
End If
Set myCell = Target '▲ダブルクリックしたセルを覚えておく
Sheets("Data").Activate
End Sub
'----------------------------------------------------------
’●(Data)のコード
'----------------------------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Rng As Range
Dim LastRow As Long
Set Rng = Range("EP63367,EP63381,EP63402,EP63388,EP63395,EP63402")
If Intersect(Target, Rng) Is Nothing Then Exit Sub
Cancel = True
myCell.Value = Target.Value '▲▲初期入力のアクティブセルに値を代入
LastRow = Sheets("拾い出し").Cells(Rows.Count, "AF").End(xlUp).Row
Range("FB63422,FE63422,FJ63422").Copy Sheets("拾い出し").Cells(LastRow + 1, "AF")
For Each Rng In Range("FP63367:FP63388")
If Rng.Value <> "" Then
LastRow = Sheets("拾い出し").Cells(Rows.Count, "AK").End(xlUp).Row
Sheets("拾い出し").Cells(LastRow + 1, "AK").Value = Rng.Value
End If
Next Rng
End Sub
'---------------------------------------------------------------------
乗りかかった船ですのでこの質問が解決するまではお付き合いするつもりです。
疑問点な遠慮なく質問してください。
以上です。
この回答への補足
myRangeさん、こんばんわ!
お礼の投稿です。
補足とお礼逆になってしまいすみませんでした。
今まで、myRangeさんに教えて頂いた事、本を見て調べながら色々組み合わせてみました。
まだ、よくわからない所だらけですがなんとか
myRangeのおかげで、やりたい事すべて出来ました。
忙しい中、何度もご指導して頂き、本当に有難う御座いました。
今後共、よろしくお願いします。
myRangeさん、回答ありがとうございます。
---------------------------------------------------------------------
(1)Range("FC63364").Activate '有効なデータの入れてないセルに戻す
意味が分かりません。
申し訳ございません。私の、書き間違えです。
("Data") ("FC63364")を基準にスイッチ類を選ぶチェックボックスがあるので、
そこを表示したいので、Range("FC63364").Activateを入ています。
(2)(Data) (FP63367:FP63388)をコピー
FP列1列コピーなのに、.Resize(1, 5) と5列扱っている
以前は、Sheets("Data").Range("FP63367:FT63388").Copyとしていました。
ですが、("FP63367:FT63388")の中には、空白がありまして空白を除きたい為、自分では解決方法がわからず、
myRangeさんに教えて頂きこの方法を使わせて頂いております。
(3)AF,AKの転記開始行のひとつ上のセルには何か入力されているか
転記行を取得するときに問題になる
はい、("AF3:AH3") ("AK3:AO3")に("商品名"型番""金額")等文字を入力してます。
それからもうひとつ
(4)Range("FP63367:FP63388")をコピーする部分で
If Rng.Value <> "" Then というコードがありますが
これはこれでいいのですですか?
申し訳ございません。
仕事が終わって、本を見ながら教えて頂いた事を、勉強しておりますが
意味が未だに理解出来ておらず、自分で判断出来ずにいます。
'---------------------------------------------------------------------
今回、教えて頂いた事をこれから実行し、意味がわかるように勉強します。
何回も、ご指導して頂き本当に感謝しております。
ありがとうございました。
No.3
- 回答日時:
回答2、myrangeです。
回答2にミスがありますので訂正します。
'--------------------------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'■Range("FC63364").Activate '有効なデータの入れてないセルに戻す
'■Sheets("初期入力").Activate
'■'選択した値を("初期入力")に戻す
'■ActiveCell.Value = Target.Value
'■の部分は何をしたいのか不明です。
'も少し分かりやすく文章で説明した方がいいでしょう。
Dim Rng As Range
Dim LastRow As Long
Set Rng = Range("EP63367,EP63381,EP63402,EP63388,EP63395,EP63402")
If Not Intersect(Target, Rng) Is Nothing Then
LastRow = Sheets("拾い出し").Cells(Rows.Count, "AF").End(xlUp).Row
Range("FB63422,FE63422,FJ63422").Copy Sheets("拾い出し").Cells(LastRow + 1, "AF")
For Each Rng In Range("FP63367:FP63388")
If Rng.Value <> "" Then
LastRow = Sheets("拾い出し").Cells(Rows.Count, "AK").End(xlUp).Row
●Sheets("拾い出し").Cells(LastRow + 1, "AK").Resize(1, 5).Value = Rng.Resize(1, 5).Value
End If
Next Rng
Cancel = True
End If
End Sub
'---------------------------------------------------------------------
IF~EndIfの範囲のミス、及び、Cancel=Trueが抜けてました。
以上です。
myRangeさん、回答ありがとうございます。
myRangeに教えて頂いた事を、ずっと実行しておりまして、
この回答に気が付かず、補足してしまい申し訳ありません。
色々とアドバイスして頂き、感謝してます。
これから、実行してみます。
ありがとうございました。
No.2
- 回答日時:
>(内容)
>(1) (初期入力!)セルをダブルクリックより(Data!)に移動して来ました。
これは、意味不明です。
やりたいことは、Dataシートのセルをダブルクリックして
Dataシートの該当セルを、”拾い出し”シートのセルにコピーしたい
ということでしょうか。
で、あれば、
▲Data▲シートのBeforeDoubleClickイベントに以下のコードを。
'--------------------------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'■Range("FC63364").Activate '有効なデータの入れてないセルに戻す
'■Sheets("初期入力").Activate
'■'選択した値を("初期入力")に戻す
'■ActiveCell.Value = Target.Value
'■の部分は何をしたいのか不明です。
'も少し分かりやすく文章で説明した方がいいでしょう。
Dim Rng As Range
Dim LastRow As Long
Set Rng = Range("EP63367,EP63381,EP63402,EP63388,EP63395,EP63402")
If Not Intersect(Target, Rng) Is Nothing Then
LastRow = Sheets("拾い出し").Cells(Rows.Count, "AF").End(xlUp).Row
Range("FB63422,FE63422,FJ63422").Copy Sheets("拾い出し").Cells(LastRow + 1, "AF")
End If
For Each Rng In Range("FP63367:FP63388")
If Rng.Value <> "" Then
LastRow = Sheets("拾い出し").Cells(Rows.Count, "AK").End(xlUp).Row
●Sheets("拾い出し").Cells(LastRow + 1, "AK").Resize(1, 5).Value = Rng.Resize(1, 5).Value
End If
Next Rng
End Sub
'---------------------------------------------------------------------
再質問では、
'("Data")("FP63367:FP63388")をコピーとなってますが
上記コードの●の部分では、Resize(1,5)となってますので
FP~FT列、AK~AOの5列の値を扱うようになってます。
それでいいのですか?
また、上記コードにSheets("Data")が出てこないのは、
Sheets("Data")がActiveSheetなので省略しているからです。
それから、転記先のAF、AKの転記開始行のセルのひとつ上には
最終行(LastRow)を取得するために、何かしらの文字が入力されていること。
入力されていないなら、質問者のコードのように、転記開始行かどうかの判断が必要です。
以上です。
この回答への補足
myRangeさん、回答ありがとうございます。
私の、説明不足で申し訳ございません。
(実現したい大項目)
・("初期入力")のB列に、スイッチの種類を入れるのですが、
項目が多い為、入力規則では選ぶのが、大変です。ですので
("初期入力")B列の、値を入れたいセルをダブルクリックし、("Data") を表示し、値の入っている特定のセルを、選んで貼り付けしたいです。
・("Data")で選んだスイッチの結果を、("拾い出し") に、材料等を書き込みたいです。
(作業工程内容です)
現在、("初期入力")の画面です。
(1) ("初期入力")B列の値の入れたいセルを、ダブルクリックし、("Data") を表示。
("初期入力")のVBAです。
────────────────────────────────
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'B列のセルを、ダブルクリックした場合、("Data")を表示する。
If Target.Cells.Count > 1 Then Exit Sub
If Target.Column <> 2 Then Exit Sub
'値が入っているセルを選択した場合、エラーを出す。
If Trim(Target.Value) <> "" Then
MsgBox ("値が入っているセルは選べません。")
Exit Sub
End If
'("Data")を表示する。
Sheets("Data").Activate
End Sub
────────────────────────────────
(A) ("Data")内でスイッチ組み合わせを選びます。(スイッチの種類・個数等)
(B) (A)の結果が
("Data")("EP63367,EP63381,EP63402,EP63388,EP63395,EP63402")
("Data")("FP63367:FT63388")
("Data")("FB63422,FE63422,FJ63422")
に記録されます。
(A) (B) はVBA範囲外です。
(2) ("EP63367,EP63381,EP63402,EP63388,EP63395,EP63402")のいずれかをダブルクリックする。
(3) (Data!) (FB63422,FE63422,FJ63422)をコピー。
(4) (3)を(拾い出し!) (AF)に値のみ貼り付け。
(5) (Data) (FP63367:FP63388)をコピー。
(6) (5)を(拾い出し!) (AK)に貼り付け。
(7) (2)でダブルクリックされた値を(初期入力!)で、ダブルクリックされたセルに貼り付け。
以上になります。
(Data!)編集後のVBAです。
■の箇所が、おかしいですが、改善できません。
■(1) 特定のセル以外を選んでも、コピーされます。
■(2) 特定のセルを選んでも、(初期入力!)に貼り付けされません。
────────────────────────────────
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'編集後
'特定のセルをダブルクリックすると、特定シートのセルにコピーをする。
Application.ScreenUpdating = False
Dim Rng As Range
Dim LastRow As Long
'下記のセルをダブルクリックした場合のみ、以降のマクロを実行。
Set Rng = Range("EP63367,EP63381,EP63402,EP63388,EP63395,EP63402")
'(Data!) (FB63422,FE63422,FJ63422)をコピー、("拾い出し) ("AF")に値のみ貼り付け。
If Not Intersect(Target, Rng) Is Nothing Then
LastRow = Sheets("拾い出し").Cells(Rows.Count, "AF").End(xlUp).Row
Range("FB63422,FE63422,FJ63422").Copy Sheets("拾い出し").Cells(LastRow + 1, "AF")
End If
'("Data")("FP63367:FT63388")をコピー、("拾い出し") ("AK")に貼り付け。
'("Data")("FP63367:FT63388")に、空白がある場合、空白を除く。
■(1) For Each Rng In Range("FP63367:FP63388")
If Rng.Value <> "" Then
LastRow = Sheets("拾い出し").Cells(Rows.Count, "AK").End(xlUp).Row
Sheets("拾い出し").Cells(LastRow + 1, "AK").Resize(1, 5).Value = Rng.Resize(1, 5).Value
End If
'("Data") ("EP63367,EP63381,EP63402,EP63388,EP63395,EP63402")の内のどれかをダブルクリックしたセルの値を、("初期入力")でダブルクリックされたセルに貼り付け。
■(2) If Not Intersect(Target, Rng) Is Nothing Then
LastRow = Sheets("初期入力").Activate
ActiveCell.Value = Target.Value
End If
Next Rng
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
────────────────────────────────
大変申し訳ありませんが、お時間がある時で結構ですので、
ご指導頂けませんか?
よろしくお願いします。
No.1
- 回答日時:
Sheet1のシートタブを右クリックするとコードを記入するウインドが現れます。
以下のコードを記入します。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 2 Then '列が2 (B列)で
If Target.Row = 3 Or Target.Row = 6 Or Target.Row = 9 Then '行が3,6,9のとき
Worksheets("Sheet2").Range("B3") = Target.Value 'Sheet2のB3に代入
Cancel = True 'ダブルクリックの通常の処理をCancel
End If
End If
End Sub
この回答への補足
rivoisuさん、おはようございます。
回答ありがとうございます。
他の、ファイルにも活用したいと思い、書き込んでみました。
ですが、コピーされない所が出てきまして、どこがおかしいのかが、どうしてもわかりません。
申し訳ありませんが、教えて頂けませんか?
下記VBAです。
(内容)
(1) (初期入力!)セルをダブルクリックより(Data!)に移動して来ました。
(2) (Data!)列が(EP)。
(3) (Data!)行が、(63374,63374,63381,63388,63395,63402)のいずれかをダブルクリック。ダブルクリックされると、(4)~(8)を起動。
(4) (Data!) (FB63422,FE63422,FJ63422)をコピー。
(5) (4)を(拾い出し!) (AF)に貼り付け。
(6) (Data) (FP63367:FP63388)をコピー。
(7) (6)を(拾い出し!) (AK)に貼り付け。
(8) (3)でダブルクリックされた値を(初期入力!)に書き込む。
以上になります。
(おかしい箇所)
(4) (5) (6) (7) で、(拾い出し!)にコピーされません。
以下が質問のVBAになります。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Range("FC63364").Activate '有効なデータの入れてないセルに戻す
Sheets("初期入力").Activate
'選択した値を("初期入力")に戻す
ActiveCell.Value = Target.Value
Application.ScreenUpdating = False
If Target.Column = 147 Then '列が (EP列)で
If Target.Row = 63367 Or Target.Row = 63374 Or Target.Row = 63381 Or Target.Row = 63388 Or Target.Row = 63395 Or Target.Row = 63402 Then
'行が63374,63374,63381,63388,63395,63402のとき
Sheets("Data").Range("FB63422,FE63422,FJ63422").Copy '("Data") ("FB63422,FE63422,FJ63422")をコピー
If Sheets("拾い出し").Range("AF4").Value = "" Then
Sheets("拾い出し").Range("AF4").PasteSpecial Paste:=xlPasteValues '("拾い出し") ("AF4")に貼り付け
Else
Sheets("拾い出し").Range("AF" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues '("拾い出し") ("AF")に貼り付け
End If
Dim Rng As Range
Dim LastRow As Long
For Each Rng In Sheets("Data").Range("FP63367:FP63388") '("Data") ("FP63367:FP63388")をコピー
If Rng.Value <> "" Then
LastRow = Sheets("拾い出し").Cells(Rows.Count, "AK").End(xlUp).Row
Sheets("拾い出し").Cells(LastRow + 1, "AK").Resize(1, 5).Value = Rng.Resize(1, 5).Value '("拾い出し") ("AK")に貼り付け
End If
Next Rng
End If
End If
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
お時間、ある時で結構ですので、ご指導お願いできませんか?
何度も、申し訳ありませんが、よろしくお願いします。
rivoisuさん、おはようございます。
回答ありがとうございました。
私の、やりたい事が出来ました!
補足に書かせて頂きましたが、別のファイルにも使用出来るかと思い
やってみましたが、おかしくなる一方で、解決できません。
朝早い時間に、回答して頂いて感謝しております。
ありがとうございました。
今後共、よろしくお願いします。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) Excelにて、行の最後のセルの値をコピーして別sheetに張りつけるVBAコードをご教授願います 3 2022/11/20 14:35
- Visual Basic(VBA) VBAについて教えてください。 Excelで セルのB6~BG24でダブルクリックすると ダブルクリ 1 2022/06/02 17:07
- Excel(エクセル) シートが違う2枚のエクセルシートにある数値を別シートにコピーしたい(VBA?) 8 2022/03/31 12:24
- Visual Basic(VBA) VBAマクロでシートコピーした新シートにコピー元シートとの計算式の入れ方を教えて下さい。 5 2022/11/20 09:48
- Visual Basic(VBA) VBA active sheetをPDF化して指定フォルダに保存 1 2022/07/07 11:27
- Visual Basic(VBA) VBA For Each 〜 複数条件について 3 2022/10/20 20:05
- Visual Basic(VBA) VBAでvlookup関数から、別シート参照するやり方・・・ 2 2022/11/14 18:49
- Excel(エクセル) Excel ハイパーリンク設定について 教えてください 例なんですが、 VBAにてファイル1の列Gに 2 2022/11/04 17:52
- Excel(エクセル) エクセルのマクロについて教えてください。 1 2023/02/25 11:55
- Excel(エクセル) 【Excel質問】別シートにある複数の同型の表から、同じ行項目にある数字を集計する 4 2023/02/16 00:14
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excel分数の表示について
-
Excelについての質問です。 B2...
-
EXCELの散布図で日付が1900年に...
-
文字2桁、3桁交じりの文字列...
-
【EXCEL】画像の黄色部分の抽出...
-
マクロエクセルのブロック解除
-
絶対参照
-
Excelで表を作ったところに文字...
-
Excelピボットテーブルの1行目
-
エクセルのクイックアクセスツ...
-
DATE関数で現在の年齢を出した...
-
(マクロ)vlookupの元データを同...
-
PDFの請求明細をエクセルにしたい
-
エクセルのクイックアクセスツ...
-
REGEXREPLACE関数について、
-
職場の人から聞かれており、こ...
-
エクセルの空欄をつめて、次の...
-
ユーザー定義関数をアドイン登...
-
EXCELの質問です 119から足した...
-
エクセルの問題です。絶対値の...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルの文字間スペースを入...
-
Excel2010でふりがなが漢字にな...
-
VBAで横データを縦データに変換...
-
VBAについて教えて頂けませんか。
-
エクセルでアンケート結果の入...
-
エクセル シート内のハイパー...
-
UserFormのTextBoxからフリガナ...
-
エクセル 置換 方法
-
【マクロ】セルの塗りつぶし色...
-
Excelから、ACCESSへデータをエ...
-
エクセルについてです。 ランダ...
-
エクセル(アクセス)で全ての...
-
エクセルのセルの中身を分離
-
Excelで同一セル内に入力されて...
-
不明なコマンドです("FROM")。...
-
Access2010 「演算子がありませ...
-
【ExcelVBA】sheet作成時にマク...
-
エクセル/マクロ Exit Subが実...
-
オペランドが足りませんとコメ...
-
mfc42.dllファイルってなんです...
おすすめ情報