VBAで重複行を削除するマクロがうまくいかない
- VBAを使用して重複行を削除するマクロを作成していますが、うまくいきません。タイトル行が最下行に残ります。
- セルの値を並べ替えた後に重複するデータを削除するVBAマクロを使用していますが、タイトル行が最下行に残ってしまいます。
- VBAで重複行を削除するマクロを作成しましたが、タイトル行が最下行に貼りついてしまいます。解決策を教えてください。
- ベストアンサー
重複行削除のマクロ
重複行を削除するマクロを作っていますが、うまくいきません。 2行目にタイトルが入っていて、3行目以降が必要なデータになります。 この中でA列が一致しているデータ行を削除したいと考えており、 重複データが削除された後、タイトル行がなぜか一番下の行にはりついてしまいます。 どなたか詳しい方助けてください!!!よろしくお願いします。 ちなみに以下が現在使用しているVBAコードです。 =============================================================== Sub GoodRemoveDuplicates() 'A列にデータが入力されており、そのデータを並べ替えた後、 '重複するデータが含まれている行を削除するマクロ Worksheets("貼り付け用用マクロ").Range("A1").Sort _ key1:=Worksheets("貼り付け用用マクロ").Range("A1") Set currentCell = Worksheets("貼り付け用用マクロ").Range("A1") Do While Not IsEmpty(currentCell) Set nextCell = currentCell.Offset(1, 0) If nextCell.Value = currentCell.Value Then currentCell.EntireRow.Delete End If Set currentCell = nextCell Loop End Sub ===============================================================
- Warabi-0212
- お礼率33% (5/15)
- Visual Basic
- 回答数3
- ありがとう数1
- みんなの回答 (3)
- 専門家の回答
質問者が選んだベストアンサー
- ベストアンサー
#2です。 重複削除が出来ないそうですが、その部分はWarabi-0212さんが作成されたもので、 Set currentCell = Worksheets("貼り付け用用マクロ").Range("A1")を Set currentCell = ws.Range("A3")に変更しただけです。 削除できない理由として考えられるのは、currentCell がA1のままかつ、A1又はA2が空白であればDo~Loopを抜けてしまうので、行削除がされない可能性はあります。 私はcurrentCellをA3から開始するように変更していますが、A1のままという事はありませんか? コードを全てコピペすれば動くはずのですが。 下記方法でも可能だと思います。 Sub Sample02() Dim i, Maxrow As Long Dim ws As Worksheet 'ワークシート名を変数wsに格納 Set ws = Worksheets("sheet1") 'A列の最終行取得 Maxrow = ws.Cells(Rows.Count, "A").End(xlUp).Row 'セルA3以下を降順ソート ws.Range(Cells(3, "A"), Cells(Maxrow, "A")) _ .Sort key1:=ws.Range("A3"), order1:=xlAscending 'A3以降の重複行を削除 With ws.Range("A3") For i = .CurrentRegion.Rows.Count To 1 Step -1 If .Offset(i, 0) = .Offset(i - 1, 0) Then .Offset(i, 0).EntireRow.Delete Next i End With End Sub
その他の回答 (2)
VBAの一例です。ご参考まで。 A列をA3以下で降順ソートしたいようですが、A列全体でソートしているようです。 A列の最終行を取得し、ソート範囲を指定するVBAとしてみました。 ワークシート名が頻繁に出てくるので変数wsに格納するように変更しました。 Sub GoodRemoveDuplicates() 'A列にデータが入力されており、そのデータを並べ替えた後、 '重複するデータが含まれている行を削除するマクロ Dim i, Maxrow As Long Dim currentCell, nextCell As Range Dim ws As Worksheet 'ワークシート名を変数wsに格納 Set ws = Worksheets("貼り付け用用マクロ") 'A列の最終行取得 Maxrow = ws.Cells(Rows.Count, "A").End(xlUp).Row 'セルA3以下を降順ソート ws.Range(Cells(3, "A"), Cells(Maxrow, "A")) _ .Sort key1:=ws.Range("A3"), order1:=xlAscending 'セルA3以下の重複行を削除 Set currentCell = ws.Range("A3") Do While Not IsEmpty(currentCell) Set nextCell = currentCell.Offset(1, 0) If nextCell.Value = currentCell.Value Then currentCell.EntireRow.Delete End If Set currentCell = nextCell Loop End Sub
補足
ご教授いただき、ありがとうございます。 早速試してみましたが、うまくいきません。 重複削除もされず、A列の順番だけが変わっている状態です。 タイトルの受付番号が一番下の行に移動し、ソートされています。 やりたいことはA列の数字の重複を見て、重複している行を削除したいです。 申し訳ないですが、再度ご教授いただけますでしょうか。 よろしくお願いします。
- CC_T
- ベストアンサー率47% (1038/2201)
Range("A1").Sort とすれば当然、A列全体がソートされますから、その時点でタイトル行が下に行ってるのでしょうね。 範囲指定してからソートしないと。
関連するQ&A
- 重複行を完全削除するエクセルのマクロ
Sub sakujyo() Dim i, ii As Long For i = 1 To Range("a65336").End(xlUp).Row For ii = Range("a65336").End(xlUp).Row To i + 1 Step -1 If Cells(i, 4).Value = Cells(ii, 4).Value _ And Cells(i, 13).Value = Cells(ii, 13).Value Then Delete Shift:=xlUp End If Next ii Next i End Sub マクロに関しては、素人でございます。 こちらのマクロを作ってみたのですがうまくいきません。 4列目と13列目の列が重複したときのみ重複した行をすべて削除させたいと思っております。どうぞお教えください。
- ベストアンサー
- オフィス系ソフト
- 重複行を完全削除するエクセルのマクロ
Sub sakujyo() Dim i, ii As Long For i = 1 To Range("a65336").End(xlUp).Row For ii = Range("a65336").End(xlUp).Row To i + 1 Step -1 If Cells(i, 2).Value = Cells(ii, 2).Value _ And Cells(i, 4).Value = Cells(ii, 4).Value _ And Cells(i, 5).Value = Cells(ii, 5).Value Then Dim iii As Byte iii = 1 Rows(ii).Delete Shift:=xlUp End If Next ii If iii = 1 Then Rows(i).Delete Shift:=xlUp iii = 0 Next i End Sub データーが下の表のように入っております。 A B C E F 1 1/26 a1234 fdsa 5000 C1 2 1/27 a4567 sdfa 4000 T2 3 1/28 a1234 dfsa 5000 C1 4 1/30 b4567 asdf 6600 A2 5 2/10 b4567 fsda 6600 A2 6 2/10 a1234 afds 5000 C1 B列、E列、F列が完全一致(重複1行目と3行目と6行目・4行目と5行目)で削除し結果的に2行目だけ残る方法がしたいのですが、このマクロですと少ないデータですとうまく動くのですが、『大量のデータを一気に削除出来ない』、『同じ重複が3つ以上のデータが多数ある場合データが削除されずに残ってしまう』エラーが出てしまいます。どうかお教えください。
- ベストアンサー
- オフィス系ソフト
- VBAで空白行を削除する
VBAでリストの空白行を削除するための適当なコードを探しているのですがどんぴしゃのものが中々見つかりません。ご教授下さい。 ブックBのシートBのリストにはA2~AN●まで値が入っています。 別のブックAからVBAで値を取り出し貼り付けています。 いくつかの方法を試しました。 (1)ブックを開いたときに空白行を削除 Sub Auto_Open() '空白行を削除 Dim lRow As Long Dim i As Long lRow = Cells(Rows.Count, 1).End(xlUp).Row Application.ScreenUpdating = False For i = lRow To 2 Step -1 If Cells(i, 1).Value = "" Then Range(i & ":" & i).Delete End If Next i Application.ScreenUpdating = True End Sub 5分以上砂時計のままで結局終わりません。 強制終了させ再度ブックを開くと空白行は削除されているのですが、こんな動作では使うことができません。 (2)ブックAの値を貼り付けた後、空白行を削除し上書き保存する Sub エクスポート() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Range(Cells(5, 7), Cells(79, 46)).Select Selection.Copy 'コピー Workbooks.Open Filename:="\\パス\ブックB.xlsm" '貼り付け先ファイルオープン Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '貼り付け Dim lRow As Long Dim i As Long lRow = Cells(Rows.Count, 1).End(xlUp).Row Application.ScreenUpdating = False For i = lRow To 2 Step -1 If Cells(i, 1).Value = "" Then Range(i & ":" & i).Delete End If Next i Application.ScreenUpdating = True '空白行を削除 ActiveWorkbook.Save '上書き保存 Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub (3)空白行を削除の部分は以下のコードも試しました Worksheets("SheetB").Range("A1").Select Set currentCell = Worksheets("sheetB").Range("A1") Do While Not IsEmpty(currentCell) Set nextCell = currentCell.Offset(1, 0) If Not IsEmpty(currentCell) Then 'カレントセルが空白でなく、 If IsEmpty(nextCell) Then '次のセルが空白のとき nextCell.EntireRow.Delete End If End If Set currentCell = currentCell.Offset(1, 0) Loop '空白行削除 宜しくお願い致します。
- 締切済み
- Excel(エクセル)
- 空白のセルを行削除する。EXCELマクロなのですが・・
VBA初心者です。 データーをHPから、単純にコピーしてきて、 EXCELに貼り付けています。 フィルターをかけても、画像かなにかがセルに張り付いているのか、 空白行をすべて削除できません。 いろいろ試して(HPから、空白セルの行削除について書かれてあるマクロを貼り付けて)動いたのが、このVBAです。 しかし、遅いので、早いVBAに簡略できればいいのですが。。 大体、1000行ぐらいの文字を貼り付けて、3/1ぐらいが空白行です。A行のセルの空白のみを、削除したいのですが。 まったくの素人なので、わかりません。 どうかよろしくお願いいたします。 Sub 空白の削除() x% = Worksheets("sheet1").Range("A65536").End(xlUp).Row For i = x% To 1 Step -1 If Worksheets("sheet1").Cells(i, 1).Value = "" Then Worksheets("sheet1").Rows(i).Delete Next End Sub
- ベストアンサー
- オフィス系ソフト
- EXCEL VBAの重複行削除について
EXCEL2010を使用しています。 添付画像の「重複行削除 前」の表を、RemoveDuplicatesで下の様にコードを組んで A列で重複する行を見て重複する行を削除しています。 Public Sub 重複行削除() With WorkSheets(1) .Range(.Cells(1, 1), .Cells(8, 3)).RemoveDuplicates _ Columns:=1, Header:=xlYes End With End Sub すると、日付の新しいデータが削除され、古いデータが残ってしまいます。 (添付画像の「重複行削除 後」) ReniveDuplicates Columns:=Array(1,3) とした場合は、すべてのデータが残ってしまいます。 添付画像の「欲しいデータ」の表の様に、 日付の新しいものを残すように重複行削除は出来ないでしょうか? 詳しい方、どうか教えてください。 よろしくお願いします。
- ベストアンサー
- Excel(エクセル)
- 行削除のマクロ
B列~F列にデータが入っていてB列の最終行の下セルを選択しクリップボードのデータを貼り付けた後、貼り付けたデータの最初の3行を削除するマクロを作っています。 Sub Macro1() ''Worksheets("Sheet1").Activate ' addrw = Range("b65536").End(xlUp).Offset(1).Row Cells(addrw, 2).PasteSpecial end sub これでB列の最終行の下にデータを貼り付けることまで出来たのですが貼り付けた最初の3行の削除の仕方がわかりません。 いい方法があれば教えていただけないでしょうか。 例えばB列の10行目まで既に入力されていた場合、11行目からクリップボードのデータを貼り付け(ここまでは上のプログラムで出来ました。)、11行目から13行目を削除したいのですがどうしたらいいでしょうか?
- ベストアンサー
- オフィス系ソフト
- Excel2000 マクロで行を削除したいのですが
みなさん、こんにちは。今、社員の給与データをもとにExcel2000 で ある集計をとるマクロを組んでいて、下記のような「給与額が0円の データのみ削除する」マクロを組みました。 Sub データ削除() Sheets("Sheet1").Select Range("A1").Select Dim 行 As Long For 行 = 6226 To 2 Step -1 With Cells(行, 7) If .Value > 0 Then Exit For If .Value = 0 Then Rows(行).Delete End With Next End Sub このマクロで正しく動いているのですが、 For 行 = 6226 To 2 Step -1 の構文の 6226 が問題で、これは 6226行目から上に向かって行を削除してい きます。 対象データの量が毎回違うので、データ量がマクロに指定されている行数より 多いと正しく動かないと思いますし、少なければ効率が悪くなるのではと思い ます。 そこで、「データの一番下のセルから削除を始める」設定にしたいのですが、 どうしたらよいでしょうか? ちなみに、データは給与額をキーに降順に並んでいて下の行から削除していく ようになっています。
- ベストアンサー
- オフィス系ソフト
- 空白行の削除マクロについてご教示ください
空白行の削除に、下記マクロを活用させていただいていますが、 見た目空白なのに削除されない行が時々残ってしまいます。 削除されなかったセルを「Deleteキー」で空白にするとマクロが 実行され、きちんと削除されます。 こういった、スペースか何かが入っていても、見た目空白なら 削除するようにはできないでしょうか。 どなたかよろしくお願いいたします。 Sub 削除() Dim c As Range Dim 開始行 As Long Dim 最終行 As Long 開始行 = 5 最終行 = Range("a5000").End(xlUp).Row For Each c In Range("a" & 開始行 & ":a" & 最終行) If c.Value = "" Then Rows(c.Row).Delete End If Next End Sub
- ベストアンサー
- オフィス系ソフト
- 条件に合った行を削除するマクロについて
こんにちは 今、現在、とある条件にあった行を削除するマクロ作っているのですが、 インターネットを調べてみると後ろから探索して、1行ずつ消していくのがいいと書いてありました。 まぁ、その理屈はわかるんですが、それなら 「Unionでセルの範囲を結合してから、最後に一度に消してしまった方が速いのでは」 (消す作業が1度だけで済むから) と思い試してみたんですが、実際試したところ・・・ ものすごく遅かったです。 (ちなみに、1万件のデータで削除した行数は6000ほどでした) 何故Union結合だと遅いのでしょうか? 速いマクロを作成するには、やはり後ろから探索して、1行ずつ消していくしかないのでしょうか? 以下は試したマクロです。 (test が unionで試したマクロ、test2が後ろから1行ずつ削除したマクロ) Option Explicit Public Sub test() Dim r As Range Dim r1 As Range 'Cells.Replace "-", " " For Each r In Range("A2", Range("A65536").End(xlUp)) If r = r.Offset(1, 0) And r.Offset(0, 1) < r.Offset(1, 1) Then If r1 Is Nothing Then Set r1 = r Else Set r1 = Union(r1, r) End If End If Next r1.EntireRow.Delete ' r1.Select End Sub Public Sub test2() Dim r As Range Dim r1 As Range Dim i As Integer 'Cells.Replace "-", " " Application.ScreenUpdating = False For i = Range("A65536").End(xlUp).Row To 1 Step -1 If Cells(i, 1) = Cells(i + 1, 1) And Cells(i, 2) < Cells(i + 1, 2) Then Cells(i, 1).EntireRow.Delete End If Next Application.ScreenUpdating = True End Sub
- ベストアンサー
- Visual Basic
- マクロでファイルを読み込み、重複行を削除したい。
35万件以上あるエクセルデータに対して、マクロを使って以下のような処理で重複業を削除したいと思っています。 Sub DeleteOldRow() Dim lastRow As Integer Dim i As Integer Dim j As Integer Dim strVal As String 'B列の最終行を求めます。 lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 2).End(xlUp).Row '1行目から最終行の前まで繰り返します。 For i = 1 To lastRow - 1 'チェックする値を、strValに代入します。 strVal = ActiveSheet.Cells(i, 2).Value '今見てる行から、下をチェックします。 For j = i + 1 To lastRow 'もし、値が同じであれば、 If strVal = ActiveSheet.Cells(j, 2).Value Then '元の行を削除します ActiveSheet.Rows(i).Delete '最終行が1行減ったのでlastRowの値を減らします。 lastRow = lastRow - 1 'チェックしている行を1行前に戻します。 j = j - 1 End If Next j Next i End Sub 上記処理を35万件あるファイル上でマクロの実行すると、オーバーフローしてしまいました。マクロ側で対象ファイルを読み込むなどして、処理を軽くするやり方はありますでしょうか。上記処理にどのような処理を加えればスムーズに処理されるでしょうか。
- ベストアンサー
- Visual Basic
お礼
うまくできました。 本当にありがとうございました!!!! 助かりました。