- ベストアンサー
マクロでの行削除処理について
- みんなの回答 (3)
- 専門家の回答
質問者が選んだベストアンサー
この手の問題は、処理ロジックが肝心で、それを検討したのかな。 >or文で行数まわすイメージを考えております。 これは非常に危険をはらんでいる。 削除によって データの繰り上がりや 最終行数の減少 があるから。 ーー ことは一緒だが、下記はその点を意識せざるをえない書き方(コード)としてあるつもり。 Sub test01() Worksheets("Sheet1").Range("A1:G100").Copy Worksheets("Sheet2").Range("A1") With Worksheets("Sheet2") .Range("A2:G100").Sort Key1:=.Range("B2"), Order1:=xlDescending, Key2:=.Range("A2") _ , Order2:=xlDescending '--- d = .Range("a65536").End(xlUp).Row MsgBox d m = .Cells(2, "B") 'データ最初行は第2行からとする i = 3 '処理は第3行目から While Not .Cells(i, "B") = "" If Cells(i, "B") = m Then .Range("A" & i).EntireRow.Delete '行削除 '行削除で繰り上がってくるから行指定はそのまま Else m = .Cells(i, "B") i = i + 1 '1行下をポイント End If Wend End With End Sub というのを考えてみた。 ーーー 逆順ソートしているので気になるので下記でもやってみた。 データが科目+番号順に昇順でソートしてあるものとして下記。 こちらは下行から上行に処理している。 Sub test02() Worksheets("Sheet1").Range("A1:G100").Copy Worksheets("Sheet2").Range("A1") With Worksheets("Sheet2") d = .Range("a65536").End(xlUp).Row MsgBox d i = d - 1 While Not i = 1 If .Range("B" & i) = .Range("B" & i + 1) Then .Range("A" & i).EntireRow.Delete '行削除 Else i = i - 1 '1行上をポイント。直下行と違う場合で、残す End If Wend End With End Sub ーーーー 少数例でしかテストしていないのでチェックよろしく。 コードの中での Sheet1.Sheet2 "A2:G100” A列、B列などは、勝手な設定なので本番では実情で改めること
その他の回答 (2)
- onlyrom
- ベストアンサー率59% (228/384)
既に回答は出てますが、、、 見出し行: 1行目 データ行: 2行目~ データ列: A~C列 (A列:番号、B列:科目、C列:適当) (1)質問のように、科目毎、番号毎に並んでいる場合 '------------------------------------------ Sub test333() Dim R As Long For R = Cells(Rows.Count, "A").End(xlUp).Row To 3 Step -1 If Cells(R - 1, "B").Value = Cells(R, "B").Value Then Rows(R - 1).Delete xlShiftUp End If Next R End Sub '-------------------------------------------- (2)項目、番号が並んでない場合 先ず、第1キー:項目、第2キー:番号 で昇順にソートするコードを追加。 '-------------------------------------------- Sub Test555() Dim R As Long Dim LastRow As Long LastRow = Cells(Rows.Count, "A").End(xlUp).Row Range("A1:C" & LastRow).Sort _ Key1:=Range("B2"), Order1:=xlAscending, _ Key2:=Range("A2"), Order2:=xlAscending, _ Header:=xlYes, OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom, SortMethod:=xlPinYin For R = LastRow To 3 Step -1 If Cells(R - 1, "B").Value = Cells(R, "B").Value Then Rows(R - 1).Delete xlShiftUp End If Next R End Sub '-------------------------------------------- 以上。
お礼
回答ありがとうございます。 本を買って色々試しているのですが、 マクロに不慣れで難しく感じております。 基礎からやり直そうと思っておりますが、 結果は報告します。
- lark_0925
- ベストアンサー率63% (37/58)
新規ブックの標準モジュールに '============================================================ Option Explicit '====================================================================== Sub main() Dim rr As Range Call サンプル作成 MsgBox "これから処理します" With Range("b2", Cells(Rows.Count, "b").End(xlUp)) If .Row > 1 Then With .Offset(0, 3) .Formula = "=if(COUNTIF($B$2:B2,B2)<countif($b$2:$b$" _ & .Rows.Count + 1 & ",b2),1,"""")" On Error Resume Next Set rr = .SpecialCells(xlCellTypeFormulas, xlNumbers) .Formula = "" If Err.Number = 0 Then rr.EntireRow.Delete End If End With End If End With End Sub '====================================================================== Sub main2() Dim rr As Range Call サンプル作成 MsgBox "これから処理します" With Range("b2", Cells(Rows.Count, "b").End(xlUp)) If .Row > 1 Then With .Offset(0, 3) .Formula = "=if(and(row()<>" & .Rows.Count + 1 & ",b2=b3),1,"""")" On Error Resume Next Set rr = .SpecialCells(xlCellTypeFormulas, xlNumbers) .Formula = "" If Err.Number = 0 Then rr.EntireRow.Delete End If End With End If End With End Sub '====================================================================== Sub サンプル作成() With ActiveSheet.Range("a1:b21") .Formula = Array("=row()-1", _ "=choose(int(rand()*5)+1,""国語""," & _ """算数"",""理科"",""社会"",""英語"")") .Value = .Value .Range("a1:b1").Value = Array("番号", "科目") End With End Sub mainとmain2の二つを用意しました。 mainは、同一科目の番号が大きいものを残します。 main2は、連続している同一科目の番号が大きいものを残します。 試してみてください。
お礼
回答ありがとうございます。 本を購入したのですが、どうしても行を追加する可能性も 考えてやるようにしようって考えるといつもfor文でやってみよう って思ってしまいます。 そうすると無限ループとかになってしまうのですが.. 試してみて結果を報告します。
関連するQ&A
- 行の削除
excel VBA行の削除をしたい。 (質問) どこがまちがいでどう直せばよいか。教えてください。よろしくお願いします。 Rows("268:271").Select Selection.Delete Shift:=xlUp のイメージで Rows("last_depth+1:d").Select Selection.Delete Shift:=xlUp として実行したら型が一致しないエラー 記述で""を取り Rows(last_depth+1:d).Select Selection.Delete Shift:=xlUp としてもコンパイルエラーとなります。 なおlast_depth、dはともに dim xx As long で定義の変数
- ベストアンサー
- オフィス系ソフト
- 行を削除するマクロ
以下のような、行を削除するマクロがあります。 Workbooks("123.csv").Activate Rows("5:10").Select Selection.Delete Shift:=xlUp しかし、123.csvを開いていない場合にはエラーが出てしまいます。 そこで、このようにしました。 On Error Resume Next Workbooks("123.csv").Activate Rows("5:10").Select Selection.Delete Shift:=xlUp しかし、エラーが出ない代わりに、アクティブなブックの行が削除されてしまいます。 123.csvが開かれている場合には、行を削除し、 開かれていない場合には、何もせずエラーも出さないようにするにはど のようにすればいいでしょうか。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- EXCELマクロデータのある行より下の行削除の構文
EXCELマクロ構文について教えてください。 データのある行のひとつ下の行全体選択し、 Ctrl+Shift+↓で下部行全て選択し、右クリックで削除する 操作をマクロにしたいのでですが、 マクロ記録では上の操作は Rows("189:189").Select Range(Selection, Selection.End(xlDown)).Select Selection.Delete Shift:=xlU になります。 この 189 という数字は 下記の変数定義で「lastRow」として取得できるのですが Dim lastRow As Long lastRow = Sheets("2CVS関西").Cells(Rows.Count, 2).End(xlUp).Row + 1 189にlastRow に置き換える方法お教えください。
- ベストアンサー
- Excel(エクセル)
- マクロでエクセルの行を準に削除したいのですが…(;_;)
エクセルのマクロを使って Range("D3:E3").Select Application.CutCopyMode = False Selection.Delete Shift:=xlUp Range("D4:E4").Select Application.CutCopyMode = False Selection.Delete Shift:=xlUp という風に3000個ほど順番に消していきたいのですがfor...nextを使うと for I = 3 to 3000 Range("DI:EI").Select Application.CutCopyMode = False Selection.Delete Shift:=xlUp nest I となってこれを実行するとDIのセルに飛んでしまいます。どうしたらいいのですか?教えて下さいお願いしますm(_ _)m
- ベストアンサー
- Visual Basic
- エクセルマクロで行を変えて100回デリート
すみません。繰り返し165行下がってデリートしたいのですが・・・ どなたか詳しい方ご教授下さいませ。 ActiveWindow.SmallScroll Down:=174 Rows("183:198").Select Selection.Delete Shift:=xlUp ActiveWindow.SmallScroll Down:=171 Rows("348:363").Select ←165行下がりデリートを繰り返しデリートしたいです。 Selection.Delete Shift:=xlUp
- ベストアンサー
- Excel(エクセル)
- excelのセル複数削除について
2箇所の範囲を削除したいのですが、 Rows("188:247").Select Selection.Delete Shift:=xlUp Rows("311:373").Select Selection.Delete Shift:=xlUp とすると最初に削除されるとRowがずれてしまって、 次のRows("311:373").Selectがうまく削除できません。 2つを同時に削除することは可能でしょうか? 最大で3つまで削除を考えています。 どうぞよろしくお願い致します。 excel2000です。
- ベストアンサー
- Visual Basic
- エクセルマクロで行を変えて千回カット&ぺースト
下記のコードでB,C,D・・・と行を1,000回変えて同じ作業をしたいのですが、どのようにしたらよいか分かりません。 どなたかお詳しい方アドバイスをお願いします。 Range("A18:A32").Select Selection.Cut Destination:=Range("B3:B17") ←B,C,D・・と変えてカットしたい。 Rows("18:32").Select Selection.Delete Shift:=xlUp Range("A18:A32").Select Selection.Cut Destination:=Range("C3:C17") Rows("18:32").Select Selection.Delete Shift:=xlUp Range("A18:A32").Select Selection.Cut Destination:=Range("D3:D17") Range("D3:D17").Select End Sub
- ベストアンサー
- Excel(エクセル)
- 【エクセル マクロ】オートフィルター後の行削除
Excel2003を使用しています。 オートフィルターを利用した作業をマクロの記録で処理していて 抽出されたデータを行ごと削除しているのですが Selection.AutoFilter Field:=1, Criteria1:="仕入先コード" Rows("4:2102").Select Selection.Delete shift:=xlUp Selection.AutoFilter Field:=2, Criteria1:="仕入先合計" Rows("7:2008").Select Selection.Delete shift:=xlUp …と、上記のような行番号で指定されてしまい 毎月データ数が増減するので、うまく処理出来ません。 (データは、テキストファイルからエクセルに取り込んでいます) 過去の例で近いものがあれば記述の中に取り込んでみましたが… これもうまくいきませんでした。 毎月変わるデータ数に対応できるマクロの記述を教えて下さい。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- オートフィルタを使わずに行削除
こんにちは。 簡易記録のマクロで実行したものが、以下となります。 オートフィルタで選択した0以下の行を削除するために選択した物になります。 Sub 0以下を削除() ' Macro test ' ActiveSheet.Range("$A$1:$G$165").AutoFilter Field:=7, Criteria1:="<=0", _ Operator:=xlAnd Rows("3:56").Select ActiveWindow.SmallScroll Down:=66 Rows("3:165").Select Selection.Delete Shift:=xlUp ActiveSheet.Range("$A$1:$G$123").AutoFilter Field:=7 End Sub 行数は、日によって、様々で何千行となる場合もあります。 そこで、オートフィルタを使用せず、G列目の0以下の数値を行削除を行いたいです。 どのように設定したらいいか教えて頂けると幸いです。 不備がありましたら、補足を入れますので、 お手数ではございますが、宜しくお願い致します。
- ベストアンサー
- Excel(エクセル)
- エクセル2010 VBA 行削除
特定列が空白であれば行削除をしたいのですが、下記コードでうまく削除は出来るのですが、応答なしになったり、とても遅いのですが、もう少し早く処理出来る方法はありますか? E列が空白であれば行削除をしたいのですが・・ With Range("E13", Cells(Rows.Count, 5).End(xlUp)) .AutoFilter Field:=1, Criteria1:="" On Error Resume Next Set rng = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) If Err.Number = 0 Then rng.EntireRow.Delete On Error GoTo 0 .AutoFilter End With
- 締切済み
- Excel(エクセル)
お礼
回答ありがとうございます。 いつもこの手のパターンだとfor文などの回数文繰り返す処理を 考えてしまいます。 試しにやってみて結果を報告します。