マクロによる行の入力と削除
- マクロを使用して、シート１とシート２の特定の行を追加および削除する方法について教えてください。
- シート２にある特定の行を追加および削除するためのマクロの作成方法について教えてください。
- 行の追加と削除を行うためのマクロを作成する方法を教えてください。
- ベストアンサー
マクロによる条件での行の入力と削除
初めまして、よろしくお願いします。 次のような二枚のシートがあります シート１ Ａ Ｂ Ｃ １ ２ ・ ９９ １００ ２３ １０１ ２５ １０２ ３１ １０３ ３４ １０４ ４３ １０５ ４４ １０６ ４９ １０７ ５０ １０８ ５５ １０９ ６０ １１０ １１１ ・ ・ シート２ Ａ Ｂ Ｃ １ ２ ・ ９９ １００ ２３ １ ２ ３ １０１ ２５ ４ ５ ６ １０２ ３１ ７ ８ ９ １０３ ３４ ０ １ ２ １０４ ４３ ３ ４ ５ １０５ ４４ ６ ７ ８ １０６ ４９ ９ ０ １ １０７ ５０ ２ ３ ４ １０８ ５５ ５ ６ ７ １０９ ６０ ８ ９ ０ １１０ １１１ ・ ・ シート１とシート２のA列に入っている数字が通し番号です。シート２では加えてその通し番号のデーター数字がＢ列、Ｃ列、Ｄ列に入っています。 のこシート１の通し番号３１が削除、代わりに通し番５番と５１番を追加し、 シート１ Ａ Ｂ Ｃ １ ２ ・ ９９ １００ ５ １０１ ２３ １０２ ２５ １０３ ３４ １０４ ４３ １０５ ４４ １０６ ４９ １０７ ５０ １０８ ５１ １０９ ５５ １１０ ６０ １１１ １１２ ・ ・ マクロを実行すると シート２ Ａ Ｂ Ｃ １ ２ ・ ９９ １００ ５ １０１ ２３ １ ２ ３ １０２ ２５ ４ ５ ６ １０３ ３４ ０ １ ２ １０４ ４３ ３ ４ ５ １０５ ４４ ６ ７ ８ １０６ ４９ ９ ０ １ １０７ ５０ ２ ３ ４ １０８ ５１ １０９ ５５ ５ ６ ７ １１０ ６０ ８ ９ ０ １１１ １１２ ・ ・ シート２がこように通し番号３１が入っていた行番１０２行が削除され、新たに通し番５番が行番１００に、５１番が行番１０８に挿入追加されるマクロを教えていただきたく、よろしくお願いします。
- kei__2000
- お礼率92% (254/275)
- オフィス系ソフト
- 回答数6
- ありがとう数6
- みんなの回答 （6）
- 専門家の回答
質問者が選んだベストアンサー
No.1・3・4です！ 何度もごめんなさい。 ごく単純に・・・ 行削除のあとすぐに行挿入し、Sheet1のA100～A199 セルをSheet2にそのままコピー＆ペーストだと間違いがないかもしれません。 Sub test3() Dim i, j As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets(1) Set ws2 = Worksheets(2) Application.ScreenUpdating = False For j = 199 To 100 Step -1 For i = 100 To 199 If WorksheetFunction.CountIf(Range(ws1.Cells(100, 1), ws1.Cells(199, 1)), ws2.Cells(j, 1)) = 0 Then ws2.Rows(j).Delete ws2.Rows(j).Insert End If Next i Next j Application.ScreenUpdating = True Range(ws1.Cells(100, 1), ws1.Cells(199, 1)).Copy Destination:=ws2.Cells(100, 1) End Sub こんなんではどうでしょうか？m（＿ ＿）m
その他の回答 (5)
- keithin
- ベストアンサー率66% (5278/7940)
また後出しの「じつは…」あるとダメかもしれません。 Sub macro1() On Error Resume Next With Worksheets("Sheet1").Range("B100:D199") .Formula = "=IF(VLOOKUP($A100,Sheet2!$A$100:$D$199,COLUMN(),FALSE)<>"""",VLOOKUP($A100,Sheet2!$A$100:$D$199,COLUMN(),FALSE),NA())" .SpecialCells(xlCellTypeFormulas, xlErrors).ClearContents .Value = .Value Worksheets("Sheet1").Range("A100:D199").Copy Destination:=Worksheets("Sheet2").Range("A100") .ClearContents End With End Sub
お礼
回答ありがとうございます。”後出し”は大変失礼しました。回答いただいたやり方でうまくできました。大変助かりました。
- tom04
- ベストアンサー率49% (2537/5117)
No.1・3です！ たびたびごめんなさい。 投稿した後で気づいたのですが、コード内にCOUNTIF関数を使っていて、検索範囲が列全体になっています。 200行目以降に100～199行にあるデータと一致するものがある場合は希望通りの動きにならないと思います。 そこでもう一度コードを訂正したものを載せておきます。 Sub test2() Dim i, j As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets(1) Set ws2 = Worksheets(2) Application.ScreenUpdating = False For j = 199 To 100 Step -1 For i = 100 To 199 If WorksheetFunction.CountIf(Range(ws1.Cells(100, 1), ws1.Cells(199, 1)), ws2.Cells(j, 1)) = 0 Then ws2.Rows(j).Delete End If If ws1.Cells(i, 1) < ws2.Cells(j, 1) And ws1.Cells(i, 1) > ws2.Cells(j - 1, 1) Then ws2.Rows(j).Insert ws2.Cells(j, 1) = ws1.Cells(i, 1) End If Next i Next j Application.ScreenUpdating = True End Sub ※ ちゃんと希望通りに動くことを期待しています。 何度も失礼しました。m（＿ ＿）m
お礼
回答ありがとうございます。こちらのやり方で範囲指定は満足できましたが、やはり行番２００以降のデーターと、なぜだか頭の行番の通し番号、例では２３が後尾についてしまうのは残念です。
- tom04
- ベストアンサー率49% (2537/5117)
No.1です！ 補足を読ませてもらいました。 前回のコードは100行目～最終行まで！としていますので、希望通りにならなかったようですね！ 前回のコードをそのまま利用する場合は2行だけの変更で大丈夫だと思います。 100～199行の間での操作だとすると、 各Sheetの最終行の部分を 199 に訂正すればOKかと思います。 ＞For j = ws2.Cells(Rows.Count, 1).End(xlUp).Row To 100 Step -1 ＞For i = 100 To ws1.Cells(Rows.Count, 1).End(xlUp).Row の行を それぞれ >For j = 199 To 100 Step -1 >For i = 100 To 199 としてみてください。 これで何とか希望通りの動きにならないでしょうか？m（＿ ＿）m
お礼
補足の回答ありがとうございます。こちらのお願い通りに行範囲はできました。 ただ、この変更では追加分が後尾につき、行番２００以降に入力されているデーターがこちらも後尾まで移動してしまうのが残念です。こちらのわがままに付き合っていただき、ありがとうございます。
- imogasi
- ベストアンサー率27% (4737/17068)
こんなのはVBAでやる理由は無いのでは。手入力と、並べ替えと行削除操作で出来るのでは。 VBAでやらなければならない理由は？ ーー 既出の回答のお礼を見ても、ただやって見て、結果が思い通りでした、を見るだけで、回答の処理のロジック（手順）の理解など出来てないのでは。少しぐらい変更できるレベルで無いと、質問して、回答をもらっても無駄では。 それで少し内容が追加・変更されると、追加質問になる。 例の挙げ方も不自然。左端の番号は行番号かデータなのか明示のこと。 何がしたいのかよくわからない。＞行番１０２行が削除され、新たに通し番５番が行番１００に、５１番が行番１０８に挿入追加される、のは、どういう理由で１０２や５や５１などが出てきたのか？ ーー 削除で言えば Sub test06() x = InputBox("削除する番号") r = Range("a:a").Find(x).Row Rows(r).EntireRow.Delete End Sub という方法も在る。全行下から、削除する番号を探していく既回答とは別の方法。 追加は最下行の下行に追加データをVBAで入力し（しかしプログラムでデータ入力は、追加行が多数あれば、Inputboxやコードの中に書き込む方法とは別の他の方法を考える必要がある。）ソートすればよいのでは。 シート１とシート２は、そのデータ内容で追加や削除について、何か関連させるのかな。
お礼
回答ありがとうございます。削除する番号を探していく方法は大変参考になりました。
- tom04
- ベストアンサー率49% (2537/5117)
こんにちは！ 一例です。 データは両Sheet共、100行目からとしています。 標準モジュールにコピー＆ペーストしてマクロを試してみてください。 Sub test() Dim i, j As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets(1) Set ws2 = Worksheets(2) For j = ws2.Cells(Rows.Count, 1).End(xlUp).Row To 100 Step -1 For i = 100 To ws1.Cells(Rows.Count, 1).End(xlUp).Row If WorksheetFunction.CountIf(ws1.Columns(1), ws2.Cells(j, 1)) = 0 Then ws2.Rows(j).Delete End If If WorksheetFunction.CountIf(ws2.Columns(1), ws1.Cells(i, 1)) = 0 And _ ws1.Cells(i, 1) <> "" And ws1.Cells(i, 1) < ws2.Cells(j, 1) And _ ws1.Cells(i, 1) > ws2.Cells(j - 1, 1) Then ws2.Rows(j).Insert ws2.Cells(j, 1) = ws1.Cells(i, 1) End If Next i Next j End Sub こんな感じではどうでしょうか？m(__)m
お礼
回答ありがとうございます。回答いただきました内容でうまくできました。しかしもしよろしければですが、こちらの説明不足で行番２００から別のデーターが入力されているために、行番２００番前まで、できればマクロ実行後に２００番以降の行にデーターが入力されている行位置がマクロ実行前と同じ位置になっていればありがたいです。わがまま言って申し訳ありません。よろしくお願いします。
補足
お礼の説明の、さらに補足です。シート１とシート２のどちらのシートにも行番２００番以降から、別のデーターが入力されています。 大変失礼しました。解る方、よろしくお願いします。
関連するQ&A
- VBAで重複していない行を削除したいです。
初めてgoo質問を使います。 sheet1とsheet2の１列目と２列目で重複していない行を sheet2から削除したいです。 例えば、 Aの列に番号？、Ｂの列に数字 sheet1 A B CDEF 1 番号A 1 2 番号A 2 3 番号A 3 4 番号C 1 5 番号C 2 6 番号F 6 7 番号F 7 8 番号F 8 9 番号F 9 10 番号F 10 sheet2 A B CDEF 1 番号A 1 2 番号A 2 3 番号A 3 4 番号B 1 5 番号B 2 6 番号B 3 7 番号C 1 8 番号C 2 9 番号D 8 10 番号D 10 があったとして、上記を下記のようにしたいです。 sheet2 A B CDEF 1 番号A 1 2 番号A 2 3 番号A 3 4 番号C 1 5 番号C 2 6 番号F 6 7 番号F 7 8 番号F 8 9 番号F 9 10 番号F 10 CDEFの列にはsheet1とsheet2で違うデータが入っています。 sheet2から重複していない行を削除したいです。 宜しくお願いします。
- ベストアンサー
- Visual Basic
- シート間の行相違検証マクロ
シート１のB列(B5:B38)に数10名の氏名を入力します。C列からM列までには数字を何個か入力します。例えば A氏、C5には4、F5には2、M5には3、 B氏、E6には3、G6には4、 C氏、F7には4、H7には8、等です。 シート２の(A3:A36)にはシート1の氏名を入力します。B列からL列までにはシート1で入力した数字に対応した数字を入力します。例えば シート1、A氏、C5の4ではシート２、A氏の行のB列に２０００、F5の2ではシート2のA氏の行のE列に1000、M5の3ではシート2のA氏の行のL列に1500、と入力します。ここで、シート2で入力した行が違っていないか。他の人の行に入力していないかの検証マクロの記述方を教えてください。尚、シート1とシート2の氏名の並びが同一の場合と、そうでないときの二通りを教えてください。よろしくお願いします。
- ベストアンサー
- Visual Basic
- エクセル 同じ内容行削除マクロ
シート1、シート2のB列を比較して同じ内容の行を削除したいと思います。（シート1な内容は300行程度です。） シート2 A列 B列 栃木県3 茨城県2 福島県5 シート1 A列 B列 C列 D列 11 埼玉県1 あ い 12 栃木県3 か き 13 群馬県1 た ち 14 福島県5 さ し 15 茨城県2 な に 上記のような例があったとします。出来上がりはシートを変えずシート1で構いません。 シート1 A列 B列 C列 D列 11 埼玉県1 あ い 13 群馬県1 た ち となるようなマクロをご教授お願い致します。
- ベストアンサー
- オフィス系ソフト
- 行抽出マクロについて教えてください。
エクセルのシート１のＢ列に整理番号（順不同）が書かれてあり、シート２のＣ列にも整理番号（順不同）が書かれてあります。 シート１は約数千行・１００列、シート２は約数万行・１００列です。このシート１のＢ１と同じ整理番号をシート２のＣ列より上から検索して、最初に見つかったセル（仮にＣ７）を含む行をシート３にコピーする。 次にＢ２について同様にしてシート３にコピーする。この時の検索範囲はＣ８以下（Ｃ７以上は検索範囲外）とする。 同様な作業を続けて、最終的には、シート３のＣ列がシート１のＢ列と同じにしたい。 これをマクロで組みたい。どなたかご教授お願いいたします。
- ベストアンサー
- オフィス系ソフト
- エクセル：マクロの起動条件
お世話になります。 以下の条件でのマクロを起動する方法、及びそのマクロを教えてください。 《条件》 ブックを開いた時、あるシートのＣ列でデータが入っている最下行の行番号とＡ列のデータが入って最下行の行番号の差が１００以下だった場合、マクロを実行する。 （なおＣ列の行番号の方が必ず大きいです） ちなみに実行したいマクロは１～６の手順です。 １．ブックを開いたとき ２．「入力用」という名前のシートのＣ列でデータが入っている最下行の行番号とＡ列のデータが入っている最下行の行番号の差が１００以下だった場合 ３．「入力用」というシートにかかっているシートの保護をはずし ４．データが入っているＣ列の最下行のＡ～Ｚ列を選択して、５０行分 下にコピーする。 （例えば、Ｃ列の最下行が３５０行の場合、Ａ３５０～Ｚ３５０まで を選択したあと４００行まで下にコピーする。） ５．再度シートの保護をかけ ６．Ａ列でデータが入っている最下行の１つ下のセルを選択する ちなみに、２の条件に当てはまらないときはマクロを実行しません。 またＣ列の最下行よりＡ列の最下行が大きい数字になることはないはずですが、もし同じかＡ列の方が大きい場合、「エラー：Ｃ列よりＡ列が大きくなっています」と画面に表示させたい。 なお、行番号の差：１００、選択するＡ～Ｚ行、５０行分下にコピー は変わる可能性があるので、修正する場合どの部分を修正すればよいかも教えてください。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセルVBAによる、行の整理
始めまして、よろしくお願いします。 シート１とシート２に次のようになっています。 シート１ Ａ Ｂ Ｃ １ ２ ・ ９９ １００ ９ １０１ ５ １０２ ３ １０３ ７ １０４ １０５ ・ ・ シート２ Ａ Ｂ Ｃ １ ２ ・ ９９ １００ ９ ３ ４ ・・・・ １０１ ５ ３ ２ ・・・・ １０２ ３ １ ０ ・・・・ １０３ ７ ５ ３ ・・・・ １０４ １０５ １０６ ９ ・・ １０７ ５ ・・ １０８ ３ ・・ １０９ ７ ・・ １１０ １１１ ９ ・・ １１２ ５ ・・ １１３ ３ ・・ １１４ ７ ・・ １１５ １１６ ・ ・ ・ ・ シート１、シート２のA列にはデーター銘の番号が。シート２のB、C、D・・・列にはデーターが入っています。シート１のA列データー銘の番号の追加（データー銘番号１）、順番を変え、マクロを実行すると シート１ Ａ Ｂ Ｃ １ ２ ・ ９９ １００ ３ １０１ ７ １０２ １ １０３ ９ １０４ １０５ ・ ・ シート２ Ａ Ｂ Ｃ １ ２ ・ ９９ １００ ３ １ ０ ・・・・ １０１ ７ ５ ３ ・・・・ １０２ １ １０３ ９ ３ ４ ・・・・ １０４ １０５ １０６ ３ ・・ １０７ ７ ・・ １０８ １ １０９ ９ ・・ １１０ １１１ ３ ・・ １１２ ７ ・・ １１３ １ １１４ ９ ・・ １１５ １１６ ・ ・ ・ ・ シート２の（100-103、106-109,111-114の３グループ）行ごとデーターすべてが、シート１A列のデーター銘番号順に整理したいと思います。実際は整理されるデーター銘番号や、行ごと（ここでは整理される100-103、106-109,111-114の３グループですが）の数はかなり多くなります。シート１で削除されたデーター銘番号は、シート２ではデーターすべてが削除されます。（ここではデーター銘番号５がそうです） 解る方、できる方、よろしくお願いします。
- 締切済み
- オフィス系ソフト
- エクセルのマクロについて教えてください
シートが３つあります。Aシートはデータが打ち込んであり、Bシートは計算を行い、Cはその結果を返します。今、Aシートの各データには頭に通し番号がふってあり、Cシートの入力エリアにその番号を打つと、vlookupでAシートのデータの中身を引っ張ってきて、それでBシートにて計算が行われています。で、その結果が再びCシートに返されます。 ところで、その計算結果をAシートの該当データに貼り付けていきたいのですが、いちいちCシートでコピー、Aシートの該当行に形式を選択して貼り付け、とやっているのですが、これをCシートで入力した通し番号とAシートの通し番号を突合して一致したところの○番目のセルに結果を貼り付ける、といったマクロは可能でしょうか。教えてください。
- ベストアンサー
- オフィス系ソフト
- 条件にて行削除をするをマクロで高速化したい
シート（最初）のA,B,C列を連結した値と シート（残）のA,B,C列を連結した値を照合させ 同じ値の場合は シート（残）の該当行を削除です。 シート（最初）は6,182行 シート（残）は7,561行です。 VLookupを使って処理時間5分です。 VLookupを使わない記述で25分です。 20,000行位のデータを処理したいのですが時間が不安です。 別スレで 「VLookupで処理3分をdictionaryオブジェクトで1秒以内にする方法」を 教えていただきましたが、流用ができません。 シート（残）内にもシート（最初）内にも重複行はありません。 私の記述は「F列を検索用に使用」となっていて F列にデータがある場合、都度記述を書換えないと 使えないので、そこも対応したいです。 照合させる値はA,B,Cの連結値というのは変わらないのですが データがある範囲は都度変化する為です。 ・A～E列とかA～H列とか ・シート残はA～E列、シート最初はA～G列とか 記述そのものを教えてください。よろしくお願いします。 Sub 自動重複削除F列使用() 'シート（最初）のA,B,C列とシート（残）のA,B,C列が一致した行は 'シート残の行を削除 'F列を検索値として使用。 Dim Line As Long Dim LastRow As Long Dim myRange As Range Dim Flag 'シート「最初」のF1に、A,B,C列を結合した値を転記 With Sheets("最初") Set myRange = .Range("F2:F" & .Cells(Rows.Count, "A").End(xlUp).Row) .Range("F2").FormulaR1C1 = "=RC[-5]&RC[-4]&RC[-3]" 'シート「最初」のF2からデータのあるところまで 'F1の規則でデータ貼付 .Range("F2").AutoFill Destination:=myRange End With 'シート「残」のF1に、A,B,C列を結合した値を転記 Sheets("残").Select LastRow = Cells(Rows.Count, "A").End(xlUp).Row Range("F2").FormulaR1C1 = "=RC[-5]&RC[-4]&RC[-3]" 'シート「最初」のF2からデータのあるところまで 'F1の規則でデータ貼付 Range("F2").AutoFill Destination:=Range("F2:F" & LastRow) On Error Resume Next '双方のシートのF列を照合させ、ヒットした行は 'シート「残」から行削除をする For Line = LastRow To 2 Step -1 Flag = WorksheetFunction.VLookup(Cells(Line, 6).Value, myRange, 1, 0) If Err.Number = 0 Then Rows(Line).Delete xlUp Else Err.Clear End If Next Line '検索に使用したＦ列を削除 Sheets("残").Select Columns("F:F").Select Selection.Delete Shift:=xlToLeft Sheets("最初").Select Columns("F:F").Select Selection.Delete Shift:=xlToLeft Sheets("残").Select Range("A1").Select End Sub ●別方法 Sub 自動重複行削除F列未使用超遅() 'VLOOKUP無 'シート（最初）のA,B,C列とシート（残）の 'A,B,C列が一致した行はシート（残）の行を削除 Dim ws1, ws2 As Worksheet Dim i, j As Long Set ws1 = Worksheets("最初") Set ws2 = Worksheets("残") For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row For j = ws2.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 If ws1.Cells(i, 1) = ws2.Cells(j, 1) And ws1.Cells(i, 2) = ws2.Cells(j, 2) And _ ws1.Cells(i, 3) = ws2.Cells(j, 3) Then ws2.Rows(j).Delete (xlUp) End
- ベストアンサー
- オフィス系ソフト
- 行抽出マクロについて教えてください。
エクセルで sheet1このように入力されております。 A列には製造番号 Ｂ列には日付 Ｃ列単価 Ｄ列記号がすでに入力済みです。 _____________________________________ 行/列 A B C D 1 123456 4/5 1020 K 2 789456 5/2 500 D 3 789789 6/2 9000 F 4 456789 6/2 5000 S ------------------------------------- sheet2には製造番号が500行ランダムに入力済みです。 _____________________________________ 行/列 A B C D 1 456789 2 789456 3 789789 4 456789 5 ： 6 ： ------------------------------------- ボタンをおしたら一致した製造番号のＢＣＤ列にsheet1の日付・単価・記号を自動的に入力したい。どなたかご教授お願いいたします。
- ベストアンサー
- オフィス系ソフト
- 行抽出マクロについて教えてください。
エクセルで sheet1このように入力されております。 A列には製造番号 Ｂ列には日付 Ｃ列単価 Ｄ列記号がすでに入力済みです。 _____________________________________ 行/列 A B C D 1 123456 4/5 1020 K 2 789456 5/2 500 D 3 789789 6/2 9000 F 4 456789 6/2 5000 S ------------------------------------- sheet2には製造番号が500行ランダムに入力済みです。 _____________________________________ 行/列 A B C D 1 456789 2 789456 3 789789 4 456789 5 ： 6 ： ------------------------------------- ボタンをおしたら一致した製造番号のＢＣＤ列にsheet1の日付・単価・記号を自動的に入力したい。どなたかご教授お願いいたします。
- ベストアンサー
- オフィス系ソフト
お礼
何度も修正回答いただきありがとうございます。こちらのやり方で、うまくできました。大変助かりました。お付き合いいただき、ありがとうございます。