エクセル重複行統合マクロの意味
- エクセル重複行統合マクロの意味について詳しく教えてください。
- Tom04さんの回答で素晴らしいマクロが紹介されていますが、マクロの詳細が分かりません。
- マクロの内容を少し編集して自分の書類に使いたいです。マクロの内容を教えてください。
- ベストアンサー
エクセル重複行統合マクロの意味
Tom04さんの回答で 以下のとても素晴らしいマクロがあり、 使用させていただきたいのですが、 詳細がわかりません。 少々編集して自分の書類に反映させていただきたく、 マクロの内容を教えていただけませんか? Sub test() 'この行から Dim i, j, k, L As Long Application.ScreenUpdating = False For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 For j = 2 To Cells(1, Columns.Count).End(xlToLeft).Column + 1 For k = Cells(Rows.Count, j).End(xlUp).Row To 2 Step -1 If Cells(k, j) <> "" And WorksheetFunction.CountIf _ (Range(Cells(2, 1), Cells(k, 1)), Cells(k, 1)) > 1 Then L = WorksheetFunction.Match(Cells(k, 1), Columns(1), False) Cells(k, j).Cut Destination:=Cells(L, j) End If Next k Next j Next i For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 If WorksheetFunction.CountA(Rows(i)) = 1 Then Rows(i).ClearContents End If Next i Application.ScreenUpdating = True End Sub 'この行まで
- kudasai
- お礼率66% (2/3)
- その他MS Office製品
- 回答数3
- ありがとう数11
- みんなの回答 (3)
- 専門家の回答
質問者が選んだベストアンサー
続けてお邪魔します。 前回は寝ぼけていましたので、ごめんなさい。 もう一度最初からコードを考えてみました。 >私の表では >重複を処理したい項目列がD3以降のD列にあります。 >統合処理をしたいのはI3からO3以降の列にあります。 すなわち↓の画像のように 項目行が2行目でデータは3行目以降にあるとし、 D列データで重複がある場合に1行にまとめる! まとめる範囲はI~O列までという解釈です。 マクロ実行後には左側の表が右側のようになります。 尚、D列が同じ場合はI~O列で重複してデータはない!という前提です。 Sub Sample2() Dim i As Long, j As Long, c As Range Application.ScreenUpdating = False For i = Cells(Rows.Count, "D").End(xlUp).Row To 3 Step -1 If WorksheetFunction.CountIf(Range("D:D"), Cells(i, "D")) > 1 Then Set c = Range("D:D").Find(what:=Cells(i, "D"), LookIn:=xlValues, lookat:=xlWhole) For j = 9 To 15 If Cells(i, j) <> "" Then Cells(i, j).Cut Cells(c.Row, j) End If Next j If WorksheetFunction.CountA(Range(Cells(i, "I"), Cells(i, "O"))) = 0 Then Range(Cells(i, "D"), Cells(i, "O")).Delete shift:=xlUp End If End If Next i Application.ScreenUpdating = True End Sub 今度はどうでしょうか?m(_ _)m
その他の回答 (2)
- tom04
- ベストアンサー率49% (2537/5117)
No.1です。 >私の表では >重複を処理したい項目列がD3以降のD列にあります。 >統合処理をしたいのはI3からO3以降の列にあります。 前回のコードは無駄なループをしているようですので、 少し変えてみました。 Sub test2() Dim i As Long, j As Long, k As Long, L As Long Application.ScreenUpdating = False 'I列~O列まで For j = 9 To 15 '変数jの列の最終行~5行目まで For k = Cells(Rows.Count, j).End(xlUp).Row To 5 Step -1 '項目列に重複があれば If Cells(k, j) <> "" Then If WorksheetFunction.CountIf(Range(Cells(4, "D"), Cells(k, "D")), Cells(k, "D")) > 1 Then 'D列に初出現行(L)を決定 L = WorksheetFunction.Match(Cells(k, "D"), Range("D:D"), False) '対象セルをその列のL行目にカット&ペースト Cells(k, j).Cut Cells(L, j) End If End If 'kとjをループ Next k Next j 'D列の最終行~2行目まで For i = Cells(Rows.Count, "D").End(xlUp).Row To 4 Step -1 'i行のI列~O列にデータがない場合 If WorksheetFunction.CountA(Range(Cells(i, "I"), Cells(i, "O"))) = 0 Then 'その行を削除 Rows(i).Delete End If '次(上)の行へ Next i Application.ScreenUpdating = True End Sub こんな感じではどうでしょうか?m(_ _)m
お礼
ありがとうございます。 実行してみたところ、L列の1箇所の統合に成功しましたが、 他の重複項目行の数字の移動と 重複項目行の削除が行われませんでした。 原因が分かりませんが修復可能でしょうか? 教えてください。
- tom04
- ベストアンサー率49% (2537/5117)
こんばんは! かなり以前に当方が投稿したコードだと思いますが、 大きな間違いをしています。 変数の宣言部分で >Dim i, j, k, L As Long は i,j,k については何も宣言していませんので、長整数型ではなくValiant型になりますので、 宣言を >Dim i as long,j as long,k as long,L as long に訂正してください。 さしあたり気づいた点だけまずは投稿します。 自分で書いたコードだと思うのですが、今コードを見ても何をやりたいのか判りません。 質問内容にそってコードを記載しているはずですので、 もう少しコードを再確認して投稿したいと思います。 まずは間違いの訂正まで・・・m(_ _)m
補足
早速のご返信ありがとうございました。 過去の内容は http://okwave.jp/qa/q7581112.html にありました。 私の表では 重複を処理したい項目列がD3以降のD列にあります。 統合処理をしたいのはI3からO3以降の列にあります。 どうぞよろしくお願いします。
関連するQ&A
- エクセルで表を展開するマクロを作りたい
こんにちは。 エクセルで表を展開したいのですがマクロが作れません。 どなたか詳しい方教えて下さい。 A B C D 1 1,2,3 abc def ghi を A B C D 1 1 abc def ghi 2 2 abc def ghi 3 3 abc def ghi というように展開したいです。 10列目くらいまで対応したマクロが作りたいです。 Sub test() 'この行から Dim i, j, k As Long Dim myArray As Variant For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 If Not Cells(i, 1) Like "*" & "," & "*" Then i = i - 1 myArray = Split(Cells(i, 1), ",") k = UBound(myArray) Rows(i + 1 & ":" & i + k).Insert For j = 0 To k Cells(i + j, 1) = myArray(j) Next j Next i For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 2) = "" Then Cells(i, 2) = Cells(i - 1, 2) End If Next i Columns("A:B").AutoFit End Sub 'この行まで これにどう付け足せばいいでしょうか? どうかご教授お願い致します。
- ベストアンサー
- Windows XP
- 重複データーの集計、削除
どなたかご教授下さい。 下記のようにD列に重複する行があればI列に集計し、行削除するマクロを作成しました。 さらに、重複する基準となる列を複数(D列,F列,G列)に増やしたいのですが、上手く出来ません。 宜しくお願い致します。 Sub test() Dim i, j For i = 19 To Cells(Rows.Count, 2).End(xlUp).row - 1 For j = Cells(Rows.Count, 2).End(xlUp).row To i + 1 Step -1 If Cells(i, 4).value = "" Then Exit Sub If Cells(i, 4).value = Cells(j, 4).value Then Cells(i, 9).value = Cells(i, 9).value + Cells(j, 9).value Rows(j).Delete End If Next Next End Sub
- 締切済み
- Visual Basic
- マクロ 行を切り取ってペーストでエラーになる
J列に「0」と「#N/A」の行を切り取って集計対象外シートに貼り付けるといったコードです。 何故か途中でエラーになります。 どこが間違っておりますか? 宜しくお願いします。 Dim LastRow As Long LastRow = Cells(Rows.Count, 10).End(xlUp).Row For i = 1 To LastRow If Cells(i, 10) = "0" Or Cells(i, 10) = "#N/A" Then Rows(i).Cut Sheets("集計対象外").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) End If Next i
- ベストアンサー
- Visual Basic
- 重複行を完全削除するエクセルのマクロ
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 展開() Dim nLast As Long Dim vAdata, i, j Dim vData nLast = Cells(Rows.Count, 1).End(xlUp).Row '行を追加削除する時は下から上が基本 For i = nLast To 1 Step -1 vAdata = Cells(i, 1) 'A列が空白ではなく、B列が空白の場合、B列以降を上と同じにする If (vAdata <> "") And (Cells(i, 2) = "") And (i > 1) Then Rows(i) = Rows(Cells(i, 2).End(xlUp).Row).Value Cells(i, 1) = vAdata End If If vAdata = "" Then 'A列の値が空白なら削除 Rows(i).Delete Shift:=xlUp Else 'A列の最後に「,」が有る場合は取り除く If Right(vAdata, 1) = "," Then vAdata = Left(vAdata, Len(vAdata) - 1) End If vData = Split(vAdata, ",") 'A列の値がカンマで区切られていた場合 If UBound(vData) > 0 Then '対象行をコピーして区切られていた数-1だけ下に挿入 Rows(i).Copy Rows(i & ":" & i + UBound(vData) - 1).Insert Shift:=xlDown 'A列の値を区切られていた値に書き換える For j = 0 To UBound(vData) Cells(i + j, 1) = vData(j) Next j End If End If Next i End Sub というマクロを教えて頂きました。 これをどのようにすればいいでしょうか? ご教授お願いします。
- ベストアンサー
- オフィス系ソフト
- 重複行を完全削除するエクセルのマクロ
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つ以上のデータが多数ある場合データが削除されずに残ってしまう』エラーが出てしまいます。どうかお教えください。
- ベストアンサー
- オフィス系ソフト
- マクロで複数の行をまとめて切り取りする方法
Iの列のセルに「テスト」があったら、その行を切り取ってシート2に貼り付ける といった流れのコードが下記です。 Sub 切り取り() Dim i, LastRow As Long LastRow = Cells(Rows.Count, 9).End(xlUp).Row For i = 1 To LastRow If Cells(i, 9) = “テスト” Then Rows(i).Cut Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) End If Next i End Sub ●Iの列のセルに「テスト」と「課題」があったら、その行を切り取ってシート2に貼り付ける といったものをしたいのです。 1. If Cells(i, 9) = “テスト” Then ↓ If Cells(i, 9) = “テスト,課題” Then 結果エラー 2. If Cells(i, 9) = “テスト” Then ↓ If Cells(i, 9) = “テスト&課題” Then 結果エラー 正常なコードを教えてくださいますか? 宜しくお願いします。
- ベストアンサー
- Visual Basic
- エクセルのマクロについて
Sub ア_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "ア") = 0 Then If InStr(.Cells(i, "D"), "ア(半角)") = 0 and .Cells(i,"D")<>"" Then MsgBox i & "行目" Cells(i, 2).Offset(0, -1).Value = "★" End If End If Next i End With End Sub このエクセルマクロはC列に「ア」があって、D列に「ア(半角)」の文字がない場合はメッセージというマクロなのですが、このマクロをア~ンまで同じ作業をしたいのですが、ひとまとめにマクロを組む事はできるのでしょうか?できる場合どのようにすれば良いでしょうか? 下記のようにして見たのですができませんでした。 Sub ア_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "[ア-ン]") = 0 Then If InStr(.Cells(i, "D"), "[ア-ン](半角)") = 0 and .Cells(i,"D")<>"" Then MsgBox i & "行目" Cells(i, 2).Offset(0, -1).Value = "★" End If End If Next i End With End Sub
- 締切済み
- オフィス系ソフト
- 条件に一致すれば行を削除するVBA
こんにちは、以下のVBAについて質問をさせてください!m(_ _)m(タイプミスがあったらすみません、処理は成功しています。) Dim data As Integer For data = Cells(Rows,Count 1).End(xlUp).Row To 2 Step -1 If Cells(data,29) = "おやつ" Then Rows(data).EntireRow.Delete End If Next おやつ 上記だと29列目に「おやつ」という文字が入っている行は消えるのですが、For data~の部分を For data = 2 To Cells(Rows,Count 1).End(xlDown).Row に変えると何も起こらなくなります。 上の行から処理するか下の行から処理するかの違いで、やっていることは同じだと思うのですが、なぜ上の行から処理をしようとするとうまくいかないのでしょうか…?!Step -1のようにどこかに+1というのを入れないといけないのでしょうか…? どなたかご教示いただけると大変嬉しいです、よろしくお願いいたします<(_ _)>
- ベストアンサー
- Excel(エクセル)
- excelマクロの重複セルの削除について
excelマクロ超初心者です。 E列に下記のようにデータが入っていたとします。 E列 1 いちご 2 りんご 3 みかん 4 いちご 5 りんご 6 れもん これを重複セルを削除して E列 1 いちご 2 りんご 3 みかん 4 れもん としたいのですが、どうすればいいでしょうか? 自分なりに調べて、下記のように記述したのですが、 Sub test() lastRow = wb.Sheets("Sheet1").Range("E" & Rows.Count).End(xlUp).Row 'E列最終行 For i = lastRow To 2 Step -1 If Cells(i, 5).Value = Cells(i - 1, 5).Value Then Cells(i, 5).EntireRow.Delete Shift:=xlUp End If Next i End Sub() E4列から下のデータしか重複セルが削除されません。 ここでいうlastRow To 2 Step -1はどういう意味なのでしょうか? すみませんが宜しくお願いします。
- ベストアンサー
- Visual Basic
お礼
感激です^^!お陰様でようやくできました。 Dの項目列の重複文字が消えなく、どうしてかと考えていましたが、 どうやら、関数がi~Oに入力されているためのようでした。 一度関数をクリアして数値のみにするために、シートの使っていないところに値のコピーをして表に戻してからのマクロ実行にしようかと思います。 ありがとうございました。 もっと勉強しないとと感じました。 関数のクリアは他に良い方法ありますでしょうか?
補足
捕捉になってしまいましたが、 関数クリアはselection.value=selection.value のようなマクロで簡単に削除できそうですね。