エクセルマクロで検索・抽出したデータを修正・更新して元データに反映

このQ&Aのポイント
  • エクセルのマクロを使用して検索・抽出したデータを修正・更新し、元データに反映させる方法を教えてください。
  • エクセルのマクロを使って、検索・抽出したデータを修正・更新して元データに反映させる方法について教えてください。
  • エクセルのマクロを活用して、検索・抽出したデータを修正・更新し、元データに反映させる方法を教えてください。
回答を見る
  • ベストアンサー

エクセルのマクロで検索・抽出したデータを修正及び更新して元データに反映

エクセルのマクロで検索・抽出したデータを修正及び更新して元データに反映させたい。 Sheet1に元データが行単位で入力されています。。   A   B    C    D    E F 1 日付 顧客名 契約料 担当 回収日 回収金額 2 3 | 50 Sheet2で複数条件でフィルタオプションをマクロで実行し結果を表示ています。   A    B    C   D    E 1 日付~ 日付マデ 顧客名 担当者 2 1/1   2/28     高橋      --------->検索条件 3 4 日付 顧客名 担当 回収日 回収金額 5 -------------------------------------->抽出結果 6 -------------------------------------->抽出結果 7 -------------------------------------->抽出結果 マクロは下記の通りです。 Public Sub 検索() Dim myRow1 As Long, myRow2 As Long '----Sheet1とSheet2のA列で最終行を捜します。 myRow1 = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row myRow2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row '----Sheet2のA5以下が入力されていたらクリアします。 If myRow2 >= 5 Then Sheets("Sheet2").Range("A5:P" & myRow2).ClearContents End If '----フィルタオプションの設定で抽出します。 '----元データはSheet1、抽出条件はSheet2のA1:D2、抽出先はSheet2のA4:E4です。 Sheets("Sheet1").Range("A1:F" & myRow1).AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Sheets("Sheet2").Range("A1:D2"), _ CopyToRange:=Sheets("Sheet2").Range("A4:E4"), _ Unique:=False End Sub 抽出結果の各セルデータを必要に応じて変更・修正(選出結果を直に)をしそれを元データ に反映(上書き?)させるようなマクロを作成したいです。 どなたかご指導よろしくお願いいたします。 うまく説明できないので画像を添付します。

  • mgjp7
  • お礼率60% (18/30)

質問者が選んだベストアンサー

  • ベストアンサー
  • myRange
  • ベストアンサー率71% (339/472)
回答No.2

質問者のレベルではChangeイベントはちょと難しいかも。。(^^;;; で、Sheet2に抽出後、修正データを入れ、 それが正しいかどうか確認した後に、Sheet1へ転記する方がいいかも。 '------------------------------------------------  Sub 更新()  Dim R1 As Long  Dim R2 As Long For R2 = 5 To Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row  For R1 = 2 To Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row  If Sheets("Sheet1").Cells(R1, "A") = Sheets("Sheet2").Cells(R2, "A") And _    Sheets("Sheet1").Cells(R1, "B") = Sheets("Sheet2").Cells(R2, "B") And _    Sheets("Sheet1").Cells(R1, "D") = Sheets("Sheet2").Cells(R2, "C") Then    Sheets("Sheet1").Cells(R1, "E") = Sheets("Sheet2").Cells(R2, "D")    Sheets("Sheet1").Cells(R1, "F") = Sheets("Sheet2").Cells(R2, "E")    Exit For  End If  Next R1 Next R2 End Sub '------------------------------------------- 一行のコードが長くなるのでRangeのValueプロパティは省いてあります。 それから処理の流れには関係ないことですが、 シートを扱うために変数を使うとコードが短くすっきりなります。   Dim WS1 As Worksheets   Set WS1 = Worksheets("Sheet1") 最初でこのようしておくと、 以後、Worksheets("Sheet1")の代わりにWS1を使えるということです。 以上です。  

mgjp7
質問者

お礼

お礼が遅くなり申し訳ございません。 大変参考になりました。 ありがとうございます。

その他の回答 (1)

  • KURUMITO
  • ベストアンサー率42% (1835/4283)
回答No.1

シート2の検索結果を表示させる際に元の表の何行目かを同時に表示させるようにします。 シート2で変更した場合にはPrivate Sub Worksheet_Change(ByVal Target As Range) で変更されたデータのある行での元の表の行を求めて元の表のデータを変更するようにすればよいでしょう。

mgjp7
質問者

お礼

ありがとうございます。

mgjp7
質問者

補足

ご回答ありがとうございます。 なにぶん初心者なので・・・ 具体的に検索表示と更新するためのマクロを教えていただけないでしょうか? よろしくお願いいたします。

関連するQ&A

  • マクロの修正ができません

    エクセルのマクロで下記の作業をしています。 よくわからないまま使っているので障害箇所がわかりません。 教えていただけないでしょうか・・ 説明の仕方も下手で申し訳ありませんがよろしくお願いいたします。 [マクロの用途] ・別シートに請求データを作成しています。 ・請求番号を入力するセルに請求番号を入力します。 ・登録したマクロボタンを押すと抽出範囲に該当する請求書のデータが抽出されます。 [障害の内容] 請求データが4行以上になると、3行まで抽出され、 4行以降は抽出されません。 以下はマクロの内容です。 Sub 抽出() ' ' 抽出 Macro ' マクロ記録日 : 2007/2/19 ユーザー名 : ***' Dim myRow1 As Long, myRow2 As Long myRow1 = Sheets("データ").Range("B65536").End(xlUp).Row myRow2 = Sheets("抽出範囲").Range("B65536").End(xlUp).Row If myRow2 >= 5 Then Sheets("抽出範囲").Range("A4:Q40" & myRow2).ClearContents End If Sheets("データ").Columns("A:Q").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("A1:A2"), CopyToRange:=Range("A4:Q40"), Unique:=True End Sub

  • フィルタ オプションの設定(データ抽出) マクロ

    マクロを使って、「sheet1」のデターを「sheet2」へ抽出するのですが、Webで最適なものがあったので、その指示通りにやりました。その例題は再現できました。しかし、それを自分に合うように設定し直すとどうしてもできません。そこで気づいたのは、「No. 月日 項目名 収入 支出 摘要 購入店名」の各セルが何らかの関係があるのではと思ったのです。この項目を変えたて自分独自のものにしたいのですが、変えたり消してしまうと抽出できません。どこをどのようにしたらよいのか教えて頂けませんか。 Sub Macro2() Dim myRow1 As Long, myRow2 As Long myRow1 = Sheets("Sheet1").Range("B65536").End(xlUp).Row myRow2 = Sheets("Sheet2").Range("B65536").End(xlUp).Row If myRow2 >= 5 Then Sheets("Sheet2").Range("B5:H" & myRow2).ClearContents End If Sheets("Sheet1").Range("B2:H" & myRow1).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("B2:B3"), CopyToRange:=Range("B5"), Unique:=False End Sub

  • マクロ!一覧から別シートへの抽出

    商品の納期や、集金日などが一覧になっている【一覧】シートがあります。 他に集金月別にシート【4月】【5月】…と一年分12シートあります。 一覧シートは、空欄セルに店舗名や納期などを随時入力していき、データは増えていくのみです。 下記のマクロでデータの抽出・抽出結果のコピー・貼り付けを行っています。 Sub Macro4() ' ' Macro4 Macro ' 集金月で抽出 Dim myRow1 As Long, myRow2 As Long myRow1 = Sheets("一覧").Range("B65536").End(xlUp).Row myRow2 = Sheets("4月").Range("B65536").End(xlUp).Row If myRow2 >= 3 Then ★ Sheets("4月").Range("A3:P" & myRow2).ClearContents End If Sheets("一覧").Range("A3:P" & myRow1).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("G1:H2"), CopyToRange:=Range("A4:P4"), Unique:=False End Sub 一覧以外のシート全てに、上記マクロを登録した【抽出】ボタンを設置し G1:H1セルには集金日と検索項目のタイトル G2セルには>=4/1、H2セルには<=4/30 抽出ボタンをクリックして一覧から取得しています。  マクロは、説明が載っているHPからの独学なのでどう応用すれば良いのかがわかりません。 一覧に追加入力し、4月シートに4月分抽出。次に5月シートに5月分抽出とすると4月シートの抽出結果が消えてしまいます。 そこで、★で指定している4月シートではなく、現在選択している”シート”としたいのですが、どのように記述すればよいかわかりません。 自分が分からない事を、どう検索してよいかも分からなくなってきたので、どうかアドバイスお願いします。

  • excel 文字抽出マクロの編集についてですが・・・

    マクロで指定した文字を含むデータを抽出するマクロを 作っていたのですが、うまく作動しません。 どこが悪いか教えてください。 Sub 指定した文字データの抽出() Dim strMoji As String strMoji = InputBox("検索文字を入力してください") strMoji = "*" & strMoji & "*" Sheets("Sheet2").Activate Cells.Clear With Sheets("Sheet1") .Range("A2").AutoFilter Filde:=3, criterial:=strMoji .Range("A2").CurrentRegion.Copy _ Destination:=Sheets("Sheet2").Range("A2") .Range("A2").AutoFilter End With Sheets("Sheet2").Columns("A:D").AutoFit End Sub

  • マクロの検索と抽出について

    いつもこのサイトの皆様にはお世話になっておりますm(_ _)m この度、マクロの検索と抽出について教えていただきたいのですが、 シート1(シート名:住所録)のB9からE30に取引会社の住所録を入力しております。 B列は1~30までの数字、C列には会社名、D列には住所、E列には郵便番号をそれぞれ入力しております。 会社名をキーワードに検索をかけて、検索結果をシート2(シート名:抽出結果)に出力されるようなマクロを作りました。下記を参考にしていただきたいのですが、質問としましては、検索を何回か繰り返し行いたく、そしてその結果を抽出結果のシートに反映させる際に、前回の出力されたセルの下に反映されるようにしたいのです。 質問にまとまりがなくて伝わりづらかったとは思いますが どなたか教えていただけないでしょうか。 よろしくお願いいたします。 Private Sub CommandButton1_Click() '#### 最初に、テキストボックスの条件を住所録シートに転記しておく。 If OptionButton1 = True Then '部分一致にチェックが入っていたら '部分一致検索は、検索条件を「*」で囲む Worksheets("住所録").Cells(4, "C").Value = "*" & TextBox1.Text & "*" ElseIf OptionButton2 = True Then '完全一致にチェックが入っている場合 '完全一致検索は、検索条件の先頭に「'=」をつける Worksheets("住所録").Cells(4, "C").Value = "'=" & TextBox1.Text End If '####  検索を実行 Sheets("抽出結果").Select '抽出結果を表示するシートを選択しておく。 Cells.Select '前回の抽出結果を消しておく Selection.Clear Range("A2").Select Sheets("住所録").Range("B9:E109").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("住所録").Range("C3:C4"), _ CopyToRange:=Sheets("抽出結果").Range("A1"), _ Unique:=False End Sub Private Sub CommandButton2_Click() On Error Resume Next Worksheets("住所録").ShowAllData End Sub Private Sub CommandButton3_Click() TextBox1.Text = "" End Sub Private Sub UserForm_Initialize() OptionButton1 = True 'あいまいにチェックを入れておく End Sub

  • フィルタオプションの設定の条件における文字について

    フィルタオプションの設定の検索条件範囲で指定した条件が半角・全角や大文字・小文字にかかわらず抽出するということはできますか? 商品情報というブックがあり、抽出シート(1枚目)と2枚目のシートにデータが入っています。 2枚目のシートのフィールド名を抽出シートのA1を基準に貼り付けています。 条件をA1:I3あたりに入力し、2枚目のシートの条件に合うものを抽出シートのA5以降に取り出すマクロを書いています。次回マクロを起動させたときにA5以降にデータがあれば削除させます。 いろいろな方に教えていただいて下記のようにできあがったのですが、ちょっと問題があって 質問しています。 Dim myRow1 As Long, myRow2 As Long myRow1 = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row myRow2 = Sheets("抽出").Range("A" & Rows.Count).End(xlUp).Row If myRow2 >= 5 Then Sheets("抽出").Range("A5:I" & myRow2).ClearContents Sheets("抽出").Range("A5:I" & myRow2).ClearFormats Sheets(2).Range("A1:I" & myRow1).AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Sheets("抽出").Range("A1").CurrentRegion, _ CopyToRange:=Sheets("抽出").Range("A5"), Unique:=False End Sub 現状では元データが全角だと半角で入力すると抽出されず、元データが小文字だと大文字は抽出されません。 いちいち元データの状態を把握しての検索になってしまいます。 このマクロを修正して全角・半角もしくは小文字・大文字にかかわらず抽出できるようにすることは可能でしょうか? どなたかご存知の方がいらっしゃれば教えていただけないでしょうか?

  • VBAによる検索、置換

    新しい台帳を作ろうとしています。 2つのシートを用いてデータベース(シート1)そのデータを日別に抽出したもの(シート2)を使い作業をしたいと思ってます。 1ブックにつき、一ヶ月分を入力するが月末には約1000件にもデータが増えてしまう。シート1には一ヶ月通して全件表示(+随時追加可能)。しかし、シート1には未入力セルがある。シート2には日付毎に抽出転記。入力内容の変更・訂正や更新は、シート2で行いたい。シート2では入力内容が判明し次第、随時入力しシート1へ反映させたい。 シート1 A B C D E 1 No. 日付 顧客 商品名 依頼先 2 1  1/2 **商店 N-01 (  ) 3 2  1/4 **商店 M-50 (  ) 4 3  1/5 ++販売 O-04 (  ) 5 4  1/4 --産業 H-07 (  ) 6 5  1/6 ##商事 M-50 (  ) 7 6  1/4 ++販売 A-30 (  ) ※そこへ日付「1/4」を選択する シート2 A B C D E 1 No. 日付 顧客 商品名 依頼先 2 2  1/4 **商店 M-50 (  ) 3 4  1/4 --産業 H-07 (  ) 4 6  1/4 ++販売 A-30 (  ) 5 ※依頼先が決まりこれを少し編集,追加し シート2 A B C D E 1 No. 日付 顧客 商品名 依頼先 2 2  1/4 **商店 M-500 "○○店" 3 4  1/4 --産業 H-07 "▲▲会社" 4 6  1/4 ++販売 A-300 "○○店" 5 終了… シート1 A B C D E 1 No. 日付 顧客 商品名 依頼先 2 1  1/2 **商店 N-01  (  ) 3 2  1/4 **商店 M-500 "○○店" 4 3  1/5 ++販売 OS-04 (  ) 5 4  1/4 --産業 H-07 "▲▲会社" 6 5  1/6 ##商事 M-500 (  ) 7 6  1/4 ++販売 A-300 "○○店"  "日付を操作できるマクロボタンがある" ボタンをクリックするとシート1の内容をシート2へ再更新するようになっている。 日付を記載しているセルがあり、マクロボタン1をクリックすると日付が進み、マクロボタン2だと戻るように なっている。  現行VBA Sub ReturnDate() Dim myRow1 As Long, myRow2 As Long myRow1 = Sheets("運行台帳").Range("C65536").End(xlUp).Row myRow2 = Sheets("日別抽出").Range("C65536").End(xlUp).Row Sheets("日別抽出").Range("F4").Value = Format(DateValue(Sheets("日別抽出").Range("F4").Value) _ - 1, "yyyy/mm/dd") If myRow2 >= 6 Then Sheets("日別抽出").Range("C6:AB" & myRow2).ClearContents End If Sheets("運行台帳").Range("C6:AB" & myRow1).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("F3:F4"), CopyToRange:=Range("C6"), Unique:=False End Sub 上記フォームを用いたうえで追加処理は次のとおりです(出来ないところ)  (1)上記載のシート2からコピーしてシート1へ貼り付けたいときにどのようにしたらいいのか? ※(2)シート1→シート2のフィルタコピペでは抜粋するだけだが逆の時には行番号が不確定である。不確定の行を指定できる方法は? 長々と申し訳ございません。宜しくお願いします。

  • Excel マクロ 担当者別抽出で列が重複する

    お世話になります。 WinXP Office2007です。 http://www.eurus.dti.ne.jp/~yoneyama/Excel/filter3.htm こちらを参考に担当者別に別Sheetにまとめたく作成してます。 抽出自体はできるのですが、Z列以降が反映されません。 マクロに対する知識が乏しく、教えて頂ければ幸いです。 参考URLでは列はB~Hまでですが私の加工しているものは C~AKまであります。抽出しますとC~Zまではきちんと反映されますが その後AA~AKまでがN~Yに置き換わって反映されています。 コードはこちらです。 Sub 担当者() Dim myrow1 As Long, myrow2 As Long myrow1 = Sheets("全部").Range("B65536").End(xlUp).Row myroe2 = Sheets("担当").Range("B65536").End(xlUp).Row If myrow2 >= 5 Then Sheets("担当").Range("B5:AK" & myrow2).crearcontents End If Sheets("全部").Range("C15:AK" & myrow1).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("B2:B3"), CopyToRange:=Range("B5"), Unique:=False End Sub よろしくお願い致します。

  • エクセルのマクロ検索について

    みなさんはじめまして。 先日より必要に駆られてエクセルのマクロを使い始めた初心者です。 なかなか独学ではうまくいかず、 皆さんのお知恵を拝借したくお願いします。 したいことは以下の通りです。 検索シートに検索会社を入力すると、一部でも一致するデータを 顧客データが入った別シートから検索し、 検索シートにリストアップすると言うことがしたいです。 データシートには  A列  B列   C列   D列    E列     F列  分類  会社名  担当者  電話番号 詳細へハイパーリンク 業務内容  ----  ●社   Aさん  123-4567  ******    XXXX  ----  ×社   Bさん  234-5678  ******    ????  ----  △社   Cさん  345-6789  ******    !!!!! などのようにデータが300社くらい入っています。 一応自分で下記のようなマクロを組んでみたのですが、 リストアップされたデータのハイパーリンクの部分が文字列になってリンクとして使えません。 解消方法、またはもっと良いマクロがあれば教示お願いします Sub 検索() Dim tmp As Range Dim y As Integer, a, firstAddress '***** 結果を表示する部分をクリアします Sheets("検索").Range("A7:ag65536").ClearContents '***** キーワードを取得 a = InputBox("検索会社名を入力してください") '***** キーワードを含むデータを検索 Set tmp = Sheets("検索元データ").Columns(3).Find(a, , , xlPart) If tmp Is Nothing Then '***** 見つからない場合 MsgBox "一致するデータはありません" Else '***** 見つかった場合 firstAddress = tmp.Address y = 7 '***** 他にもあるか探してあれば記載 Do Sheets("検索").Range("c" & y) = tmp Sheets("検索").Range("b" & y) = tmp.Offset(0, -1) Sheets("検索").Range("d" & y) = tmp.Offset(0, 1) Sheets("検索").Range("e" & y) = tmp.Offset(0, 2) Sheets("検索").Range("f" & y) = tmp.Offset(0, 3) Sheets("検索").Range("g" & y) = tmp.Offset(0, 4) Sheets("検索").Range("h" & y) = tmp.Offset(0, 5) Sheets("検索").Range("i" & y) = tmp.Offset(0, 6) Sheets("検索").Range("j" & y) = tmp.Offset(0, 7) Set tmp = Sheets("検索元データ").Columns(3).FindNext(tmp) y = y + 1 Loop Until tmp.Address = firstAddress End If End Sub

  • オートフィルタをマクロで書いたのですが、一部うまくいかなくて困っていま

    オートフィルタをマクロで書いたのですが、一部うまくいかなくて困っています。 わかる方がいらしたらぜひご教授ください。 商品情報というブックがあり、抽出シート(1枚目)と2枚目のシートにデータが入っています。 2枚目のシートのフィールド名を抽出シートのA1を基準に貼り付けています。 条件をA1:I2に入力し、2枚目のシートの条件に合うものを抽出シートのA5以降に取り出すマクロを書いています。次回マクロを起動させたときにA5以降にデータがあれば削除させます。 そこで問題なのですが、A1:I2の条件だとA列からI列までのフィールド名に対する条件を 1行入力することができますが、同じ行になるのでAND条件になってしまいます。 本当は条件列をI3までにして、条件を2行にわたって書いて または条件も検索したいのです。 ただ、または条件は入力する場合と入力がない場合があります。 条件をA1:I3(3行目)に変更してマクロを実行すると、または 条件がある場合はちゃんとでるのですが、条件がない場合はすべてでてきてしまいます。 どのようにすればA1:I3に変更して、2行目と3行目に条件があった場合はその条件で該当するものを 抽出し、特に3行目に条件がない場合は2行目だけの条件で抽出できるのでしょうか? (2行目のAnd条件検索と3行目のまたは条件検索ができますでしょうか?) Dim myRow1 As Long, myRow2 As Long myRow1 = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row myRow2 = Sheets("抽出").Range("A" & Rows.Count).End(xlUp).Row If myRow2 >= 5 Then Sheets("抽出").Range("A5:I" & myRow2).ClearContents Sheets("抽出").Range("A5:I" & myRow2).ClearFormats End If Sheets(2).Range("A1:I" & myRow1).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Worksheets("抽出").Range("A1:I2"), CopyToRange:=Sheets("抽出").Range("A5"), Unique:=False End Sub

専門家に質問してみよう