[[20170116153011]]　『行を検索して、列にコピーし、更新で上書きする』（オヤンズ）　ページの最後に飛ぶ

『行を検索して、列にコピーし、更新で上書きする』（オヤンズ）

初めて投稿させていただきます。

要約通り、Sheet1にある行を検索して、Sheet2に列で表示させ、それをシート１に上書きする方法を探しております。

(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は修正不可にしたいので

 であれば　１行目にタイトル行をおいたうえで、D列を選択してセル書式、保護のロックをはずします。
 で、オートフィルターを設定します。
 その状態で、シート保護、操作者に許可する操作の　オートフィルターの使用にチェックをつけて保護します。

 これでフィルタリング可能で、D列の値は変更でき、かつ他のセルはさわれません。

（β） 2017/01/16(月) 16:22

こんにちは

検索結果が複数あるという事は、同じD列のコードでどの行のデータか判別がつかないとダメです。

Sheet1にユニークな連番を付けるとか、行番号も検索結果に合わせて表示するようにしないと。

検索結果はA列だけのように見えますが、どの部分を訂正するのですか？

（ウッシ） 2017/01/16(月) 16:24

β様　ウッシ様　ありがとうございます。

書き方が悪かったようですいません・・・
Sheet2で検索をかけるとSheet1の結果が列で表示されるようにしたいのです。
その上でSheet2に表示されたものを訂正したく思います。
訂正はSheet2のＡ列すべてが対象となります。
(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

こんばんは
A列に縦に抽出したデータを修正すれば
元のデータが上書きされるようにしてあります。
ボタンの方がいいですか？
（ウッシ） 2017/01/16(月) 20:33

ウッシ様　おはようございます。

ありがとうございました。
こちらで大丈夫です。大変助かりました。

ただ、今後の勉強の為にボタンでの訂正操作方法を教えていただければと思います。
お手隙の時で結構ですのでおねがいできますでしょうか。

度々、お手数をおかけいたします。

（オヤンズ） 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

コメント返信：

[ 一覧(最新更新順) ]

[[20170116153011]] 『行を検索して、列にコピーし、更新で上書きする』（オヤンズ） ページの最後に飛ぶ

[[20170116153011]]　『行を検索して、列にコピーし、更新で上書きする』（オヤンズ）　ページの最後に飛ぶ