VBAデータを戻すコード

このQ&Aのポイント
  • VBAを使用して、変更された行のデータを検索し、特定の条件を満たす場合に他のシートにコピーするコードを作成したいです。
  • シート1と他のシートの特定の範囲のデータを見比べて、条件に合致するデータをコピーして貼り付けたい場合、VBAを使用することが可能です。
  • VBAを使えば、特定の条件を満たすデータの検索とコピーを自動化することができます。
回答を見る
  • ベストアンサー

VBA データを戻すコード

おはようございます。 データを戻すコードが分からない為質問させていただきます。 やりたいこと 前提として シート2やシート3は A1からC100セルまで文字が書かれています。 シート1に A1からC200セルまで文字が書かれています。 そのセルのAセル以外の範囲(B1:C200)のどれか が変更が有れば(例:B110セルが変更なら110行目をコピーする) その変更された行をコピーし シート2やシート3内をAセルの行(1から100行まで)検索し シート1の110行目のAセルの文字とAセルの文字が当てはまったら (例A30セルに同じ文字が有れば) シート1でコピーしたセル (上の例であれば110行目コピーされたもの) を30行目に貼り付けを行う。 といった処理をしたいのですが 出来ましたらコードを記載していただきたいです。 すいませんが回答よろしくお願いいたします。

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

  • ベストアンサー
  • kkkkkm
  • ベストアンサー率65% (1615/2454)
回答No.1

シート1のシートモジュールに以下のコードで試してみてください。 シート名は実際のシート名からコピペしてください。 一致するものが一か所しかない場合 Private Sub Worksheet_Change(ByVal Target As Range) If Application.Intersect(Target, Range("B1:C200")) Is Nothing Then Exit Sub End If Application.EnableEvents = False Dim Ws(1) As Worksheet Dim mRng As Range, i As Long Set Ws(0) = Worksheets("シート2") Set Ws(1) = Worksheets("シート3") For i = LBound(Ws) To UBound(Ws) With Ws(i) Set mRng = .Range("A1:A100").Find(What:=Cells(Target.Row, "A").Value, LookIn:=xlValues, LookAt:=xlWhole) If Not mRng Is Nothing Then Rows(Target.Row).Copy .Rows(mRng.Row) End If End With Next Set Ws(0) = Nothing Set Ws(1) = Nothing Application.EnableEvents = True Cells(Target.Row, Target.Column).Select End Sub 複数一致する可能性がある場合 Private Sub Worksheet_Change(ByVal Target As Range) If Application.Intersect(Target, Range("B1:C200")) Is Nothing Then Exit Sub End If Application.EnableEvents = False Dim Ws(1) As Worksheet Dim mRng As Range, i As Long Set Ws(0) = Worksheets("シート2") Set Ws(1) = Worksheets("シート3") For i = LBound(Ws) To UBound(Ws) With Ws(i) For Each mRng In .Range("A1:A100") If mRng.Value = Cells(Target.Row, "A").Value Then Rows(Target.Row).Copy .Rows(mRng.Row) End If Next End With Next Set Ws(0) = Nothing Set Ws(1) = Nothing Application.EnableEvents = True Cells(Target.Row, Target.Column).Select End Sub

TaikooniQ1
質問者

補足

ご回答ありがとうございます。 一度このコードで確かめてみて 勉強させていただきます。

その他の回答 (1)

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.2

回答者を道具に使うやりかただ。 死でに回答は出ているし、VBA全体ではありふれた時候と思う。 シート、セルを質問者の売位に当てはめて、特定して当てはめたコードぐらい自分で書くこと。 エクセルVBA学習でも上級の、イベントという仕組みを 使うことになろうが、使うにはそれなりに心得て使わないと危険。 特に他人が操作するシートなどの場合。 今後もVBAを使う予定なら、自分でも勉強すべきだ。 >データを戻すコードが分からない為質問させていただきます。 コードのことではなくて、エクセル(VBA)でできる・提供されている機能や、仕組みも勉強してないと思う。分っておれば、もっとピンポイントの限定した書き方の質問になるはず。 「何々したら」XXしたい、は、思いつく「何々」のケースは沢山あって、初心者でも頻繁に思い浮かぶが、直ぐ上はクラスというものを勉強しないと、またさらに先もあり、通常人はVBAでは出来ないことも多いと思う。

TaikooniQ1
質問者

補足

回答とはまったく違うことは求めていません。 ヒントや回答の糸口になりそうなことを 回答するわけでもなく ただ単に勉強しろ等説教をして 自分が気持ちよくなるために回答をするのは これから控えてください。

関連するQ&A

  • エクセルVBAコピーしたセルを順番に張り付ける方法

    おはようございます。 for文の処理方法がわからないので質問します。 やりたいこと 例・sheet2・sheet2・sheet4・・・と A~B列のセルに文字が有る場合 B列のセルに文字が有れば その行全体をコピーして 【貼り付け】シートに張り付けたいのですが 私の考えたコードだと コピーまではうまくできるのですが 【貼り付け】シートに行全体を張り付ける際 行を上書きされてしまいます。 (sheet2の行を張り付けたら 次にsheet3の行を貼り付けシートに上書きしてしまう) このような上書きをされずに すでに【貼り付け】シートにコピーされたものが有る場合 一つ下の行に貼り付けって出来ないでしょうか? コードを下記に記載します。 すいませんがコードを書いて頂けると助かります。 宜しくお願い致します。 追記:【貼り付け】シートは一番左端にあります。 Sub test() Dim b As Variant Dim i As Long Dim io As Integer Const  AAA  As String = "" Set b = Worksheets("貼り付け") For i = 1 To 100 For io = 2 To ThisWorkbook.Worksheets.Count If WorksheetFunction.CountIf(Worksheets(io).Rows(i), "") > 0 Then  Worksheets(io).Rows(i).Copy   b.Rows(i).Offset(1, 0).PasteSpecial (xlPasteAll)’ここの貼り付け方が間違ってますよね・・・ End If Next Next End Sub

  • エクセルVBAについてお尋ね致します。数式が入力されたセルを異なるセル

    エクセルVBAについてお尋ね致します。数式が入力されたセルを異なるセルの条件によって「値」のみ残す方法を模索しております。 使用する列および行の例 列=A、B  行=5~10、15~20、25~30(A列、B列共通) 上記対象セルの内訳 A列(参照セル)=数値 ※空欄の場合もあります B列(変更セル)=数式(Aセル数値 * ○○%) ※B1セルの例:=IF(A1="","",A1*10%) のような数式が記入されております。 (例) Private Sub CommandButton1_Click() ’参照セルの指定 ("A5:A10","A15:A20","A25:A30") のようなコード*** ※現在はAセルの範囲としておりますが、後に変更の可能性を有しますので範囲指定が可能な形式を望みます。 ’変更セルの指定 セル指定のコード*** ※現在はBセルとしておりますが、これも後に変更の可能性を有しますのでA・B・Cのような入力(もしくはA=1、B=2、C=3)による指定可能な形式を望みます。 ’参照セル(Aセル)に数値が入力されている場合、数式から得られた変更セル(Bセル)の値を”値のみ”で残す。 実行コード*** ※参照セル(Aセル)が空欄の場合は変更を望まないので、変更セル(Bセル)は何も致しません。(数式のまま残す) End Sub このようなマクロを望んでおります。 イメージとしては数値がAセルに入力されていた際に同じ行のBセルにおいて右クリックコマンド内〔コピー〕 → 〔形式を選択して貼り付け〕 → 〔値〕の貼り付けを行うことをご想像下さい。 列や行の変更が予想されるので変更が可能なことを望んでおりますが、結果が伴えば他の体裁は気に致しません。 お手数ですがご教授宜しくお願い致します。 以上

  • VBA教えて下さい

    VBA初心者です。 思った結果が出ず手詰まりしました。 こういった場合のコードを教えて欲しいです。 まず、例として エクセルファイル名が 試験1(sheet1) 試験2とします(sheet2) 試験1のsheet1の中にある B1~B100セルの文字をコピーするが セルの背景色が塗られているセルはコピーしない (セルの背景色塗りつぶしなしだけコピーするといった内容です) そして、試験2のsheet2のB1~B100に貼り付けるが空白行は上に詰めるようにする 回答お願いします。

  • VBAにてデータを振り分けたい。

    2つのシート(sheet1、sheet2)があり、sheet2に振分けるデータ(下表)を作成しておきます。   (列)  A   B   C   D (行)   1     山   川   地   空  2     ○   △   ×   □  3     ア   イ    ウ   エ (1)ユーザーフォームを作成し、その中にコンボボックスを作成して山を入力する。 山は、セルA1へ、川は、セルB2へ、地は、セルC3へ、空は、セルD1、それぞれ 決められたセルにコピーされる(すべてsheet1へコピー)。 (2)にコンボボックスにて○を入力する。○はセルA1へ、△は、セルB2へ、×は、 セルC3へ、□は、セルD1へ、それぞれ決められたセルにコピーされる(すべて sheet1へコピー)。 ちなみに(1)と(2)のコピーされるセルの位置は同じ場所です。 というようなものをExcelのVBAにて作成したいのですが、VBAは、まだよくわかりません。 出来れば、sheet1のセルに数式などを入力したくはないのですが...。 どうか皆様のご指導を宜しくお願い致します。

  • "VBAの繰り返し"についてお尋ねします。VBA初心者です。

    "VBAの繰り返し"についてお尋ねします。VBA初心者です。 例えば「A列の最後のセルに何か入れば、その行のB列、C列・・・の一つ上のセルに入っている計算式を繰り返しコピーする」と言うコードを教えていただけたらと思います。A列の最後のセルに何か入ってくれば、その行の一つ上のセルに入っている計算式を繰り返しコピーするというコードです。コード記述の例を教えていただけたらと思います。よろしくお願いします。

  • vbaでシートより100より大きい値を削除するコードを教えてください

    vba初心者です。 値の羅列のシートでセルの値が100より大きいセルはのある行は削除したい時どのようなコードを書けばわからず苦慮してます。 例として下記のようなシートの場合どうかきますでしょうか? A B C D E F ---------------------------------------- 1 20090101 20 30 95 40 ---------------------------------------- 2 20090102 25 35 105 45 ---------------------------------------- 3 20090103 40 50 110 50

  • 【excel2003 vba】指定した文字列が入力されている「セル範囲」の表示方法?

    ◎Sheet1  A B C D E 1○○○-- 2○○○×× 3---×× 4×○--- ※「-」は空白 上記のようにセルに「○」「×」が入力されている「Sheet1」シートがあります。(例として○×の2種類を使っていますが、本当はもっとたくさんの種類の文字列があります。) vbaを使って、以下の一覧表を「List」シートに作成するコードを作成できませんでしょうか? ◎List  A     B 1○     ×  '文字列の種類 2A1:C2  D2:E3 '文字列の範囲  3B4     A4  '同上 【ToDo】 (1)1行目に文字列(○、×)を入力する (2)1行目に入力してある文字列が入力されているすべての「セル範囲」を2行目以降の各列に抽出する。 **1セル内に「○」「×」の両方が入力されているものもある。**  ⇒例えば、A1セルに「○×」と入力されていたら、「Rist」シートのA列B列の両方に「A1」が抽出されるようにしたい。 1セルごとのセル番地(○:A1,A2,B1,…)を一覧化することはできるのですが、同じ文字列をまとめた「範囲」の抽出ができないのです。 どなたかお力添えをお願いできませんでしょうか? 宜しくお願い致します。

  • Excel VBA データの転記

    Excel2003を使用しています。 Sheet1のB1セルとSheet2のB1セルのデータが一致したら、Sheet2のB1セル~E1セルのデータをSheet1のF1セル~Iセルに転記するというコードを書いています。 Sheet1のデータ最終行を取得して、上記の条件を満たさなかったSheet2のB1セル~E1セルのデータをSheet1のデータ最終行の1行下から順に転記するという内容を追加したいのですが、転記先の指定の仕方が悪いのか、希望通りになりません。 どなたか一例を示していただけないでしょうか? スマホからの投稿で、実際に書いているコードを記載できず、分かりづらくて申し訳ないのですが、よろしくお願いします。

  • VBAの

    VBAで特定の列で文字マッチングをして、ヒットした行をシートAからシートBにコピーしたいと考えています。 単にセルの値を全コピーするだけなら可能です。しかし、このときにシートAが何行、何列あるか分からない場合、可変長なシートAを特定の列で文字マッチングをして、シートBにコピーするためにはどのようにすればよいのでしょうか?

  • 「セルにある値」名のシートのデータコピー方法

    初心者なのですが上司に頼まれてしまい、うまく作れなくて困っています。 いろいろ調べて下のところまで作れましたが、他にどうしたら良いかわからなくなりました。 やりたい事 ・「集計シート」のセル(B3からB15)に入力したシート名から  一部のセルをコピーし、順に「集計シート」に貼り付ける 例:「集計シート」のB3にA B4にB B5にC    B6には空欄(これ以上はシートなし)  「Aシート」の(G1:J5)を「集計シート」のB5を先頭に貼り付け  「Bシート」の(G1:J5)を「Aシート」貼付分の後に一行入れ貼り付け  「Cシート」の(G1:J5)を「Bシート」貼付分の後に一行入れ貼り付け  以上 疑問 「Do until」で空欄になるまで貼付を繰り返せない(混乱中) 「Aシート」の貼り付け後に一行空けて、貼り付けの繰り返し (これはまったくわからない) 行 = 3 Do Until Range("B" & 行).Value = "" シート名 = Range("B" & 行).Value '←ここがエラーになります Worksheets(シート名).Select   '←この2行がまずおかしい? コピーセル範囲 = "G1:J5" 貼付先シート名 = "集計シート" 番号 = "D6" 貼付先左上端セル = "D7" Range(コピーセル範囲).Copy Worksheets(貼付先シート名).Range(貼付先左上端セル).Paste Application.CutCopyMode = False Sheets("集計シート").Select 行 = 行 + 1 Loop End sub

専門家に質問してみよう