[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『行を検索して、列にコピーし、更新で上書きする』(オヤンズ)
初めて投稿させていただきます。
要約通り、Sheet1にある行を検索して、Sheet2に列で表示させ、それをシート1に上書きする方法を探しております。
(Sheet1)
A B C D E 1 薬品1 ヤクヒン1 500円 490112 備考 2 薬品2 ヤクヒン2 800円 490220 備考 3 薬品3 ヤクヒン3 400円 490102 備考
(Sheet2)
A B C 1 "検索セル" 2 検索結果 3 検索結果 4 検索結果 5 検索結果 6 検索結果
Sheet1に検索するデータが入っており、Sheet2の検索セルにSheet1のD列を検索し、検索結果をA列に表示させる仕組みです。
そして、検索結果を訂正した物をSheet1の行に戻す作業をしたいのですが、マクロでどの様に組んだらよいか全くわからない状況です。
大変お手数をおかけいたしますがお知恵をお借りできればと思います。
よろしくお願いいたします。
< 使用 Excel:Excel2010、使用 OS:Windows10 >
Sheet1の1行目に項目名を設定して、オートフィルタを掛けて、
D列で抽出したいデータのみチェックを入れるか、テキストで指定して絞り込んで
対象のデータを修正すればいいのでは?
マクロにするのは必須なのですか?
(ウッシ) 2017/01/16(月) 15:48
私も出来ればSheet1をオートフィルタをかけたいのですが、Sheet1は修正不可にしたいのでこの様な形となっています。
お手数おかけいたします。
(オヤンズ) 2017/01/16(月) 16:16
>>Sheet1は修正不可にしたいので
であれば 1行目にタイトル行をおいたうえで、D列を選択してセル書式、保護のロックをはずします。 で、オートフィルターを設定します。 その状態で、シート保護、操作者に許可する操作の オートフィルターの使用にチェックをつけて保護します。
これでフィルタリング可能で、D列の値は変更でき、かつ他のセルはさわれません。
(β) 2017/01/16(月) 16:22
検索結果が複数あるという事は、同じD列のコードでどの行のデータか判別がつかないとダメです。
Sheet1にユニークな連番を付けるとか、行番号も検索結果に合わせて表示するようにしないと。
検索結果はA列だけのように見えますが、どの部分を訂正するのですか?
(ウッシ) 2017/01/16(月) 16:24
書き方が悪かったようですいません・・・
Sheet2で検索をかけるとSheet1の結果が列で表示されるようにしたいのです。
その上でSheet2に表示されたものを訂正したく思います。
訂正はSheet2のA列すべてが対象となります。
(Sheet1)
A B C D E 1 薬品1 ヤクヒン1 500円 490112 備考 2 薬品2 ヤクヒン2 800円 490220 備考 3 薬品3 ヤクヒン3 400円 490102 備考
(Sheet2)
A B C 1 490220 2 薬品2 3 ヤクヒン2 4 800円 5 490220 6 備考
(オヤンズ) 2017/01/16(月) 17:01
Sheet2のシートタブを右クリックしてコードの表示でVBE画面だして、
Private Sub Worksheet_Change(ByVal Target As Range)
Dim s As Worksheet Dim v As Variant Set s = Worksheets("Sheet1") If Target.Address = "$C$1" And Target.Count = 1 Then v = Application.Match(Target.Value, s.Range("D:D"), 0) If IsError(v) Then MsgBox "対象データ無し" Exit Sub End If Application.EnableEvents = False s.Cells(v, 1).Resize(, s.UsedRange.Columns.Count).Copy Range("A2").PasteSpecial , , , True Application.EnableEvents = True ElseIf Not Intersect(Target, Range("A2:A" & _ s.UsedRange.Columns.Count + 1)) Is Nothing Then v = Application.Match(Range("C1").Value, s.Range("D:D"), 0) If IsError(v) Then MsgBox "対象データ無し" Exit Sub End If Application.EnableEvents = False s.Cells(v, Target.Row - 1) = Target.Value Application.EnableEvents = True End If End Sub
をコピペしてからC1にコード入力してみて下さい。
(ウッシ) 2017/01/16(月) 17:25
ありがとうございます。
出来ました。
あと、大変厚かましいのですが、訂正時検索したデータに上書きする方法はないでしょうか?
ボタンを使って行いたいと思うのですが・・・
申し訳ありませんが、よろしくお願いいたします。
(オヤンズ) 2017/01/16(月) 19:57
ありがとうございました。
こちらで大丈夫です。大変助かりました。
ただ、今後の勉強の為にボタンでの訂正操作方法を教えていただければと思います。
お手隙の時で結構ですのでおねがいできますでしょうか。
度々、お手数をおかけいたします。
(オヤンズ) 2017/01/17(火) 08:14
先に提示したコードの、
ElseIf Not Intersect(Target, Range("A2:A" & _ s.UsedRange.Columns.Count + 1)) Is Nothing _ And Target.Count = 1 Then v = Application.Match(Range("C1").Value, s.Range("D:D"), 0) If IsError(v) Then MsgBox "対象データ無し" Exit Sub End If Application.EnableEvents = False s.Cells(v, Target.Row - 1) = Target.Value Application.EnableEvents = True
の部分を削除して、Sheet2にフォームのボタンを作成してマクロの登録で
Sub ボタン1_Click()
Dim s As Worksheet Dim v As Variant Set s = Worksheets("Sheet1") v = Application.Match(Range("C1").Value, s.Range("D:D"), 0) If IsError(v) Then MsgBox "対象データ無し" Exit Sub End If Application.EnableEvents = False Range("A2:A" & s.UsedRange.Columns.Count + 1).Copy s.Cells(v, 1).PasteSpecial , , , True Application.EnableEvents = True Application.CutCopyMode = False End Sub
にして下さい。
(ウッシ) 2017/01/17(火) 08:25
ありがとうございました。
お忙しい中、本当に助かりました。
(オヤンズ) 2017/01/17(火) 09:31
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.