• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:EXCELでマクロの記録を繰り返して)

Excelマクロの記録を繰り返して重複した行をまとめる方法

このQ&Aのポイント
  • Excelでマクロの記録を繰り返し、重複した行をまとめる方法をご紹介します。
  • マクロの記録を繰り返すことで、重複した行を見つけることができますが、もっと効率的にまとめる方法もあります。
  • 順番を入れ替えたり、特定の条件を使ってまとめることで、より効率的に重複した行をまとめることができます。

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

  • ベストアンサー
  • end-u
  • ベストアンサー率79% (496/625)
回答No.2

シートを切替える度に設定し直す処理はかなり効率が悪いように思えるのですが、 そこはあまり突っ込まないようにします。 ただ、そのコードが"予約状況"シートであれば、シート保護で対応できるのでは?、という疑問はありますね。 以下、ざっくりコードで Sub sample()   Worksheets("予約状況").Unprotect   With Range("A1:A2,B1:B2,C1:C2,D1:D2,E1:E2,F1:F2,G1:G2,H1:H2,I1:I2,J1:J2," & _       "K1:K2,L1:L2,M1:M2,N1:O1,P1:Q1,R1:S1,T1:U1,V1:W1,X1:Y1,Z1:AA1," & _       "AB1:AC1,AD1:AE1,AF1:AG1,AH1:AI1,AJ1:AK1,AL1:AM1,AN1:AO1")     .HorizontalAlignment = xlDistributed     .VerticalAlignment = xlCenter     .WrapText = False     .Orientation = 0     .AddIndent = True     .IndentLevel = 0     .ShrinkToFit = False     .ReadingOrder = xlContext     .MergeCells = True   End With   Rows.RowHeight = 25   Rows("1:2").RowHeight = 17   Range("A:F").Columns.AutoFit   Range("G:K").ColumnWidth = 8   Range("B:C,L:M").ColumnWidth = 21   Range("N:AN").ColumnWidth = 23   Range("O1,Q1,S1,U1,W1,Y1,AA1,AC1,AE1,AG1,AI1,AK1,AM1,AO1").ColumnWidth = 9   Range("AP1").ColumnWidth = 0.2   Range("AQ1", Cells(1, Columns.Count)).Columns.Hidden = True   With ActiveWindow     .FreezePanes = False     .Split = False     Application.Goto Range("A1"), True     .SplitColumn = 3     .SplitRow = 2     .FreezePanes = True   End With   'Range("A3").Activate   With Range("A3", Cells(Rows.Count, "AO"))     .Phonetics.Visible = False     .VerticalAlignment = xlCenter     .WrapText = False     .Orientation = 0     .AddIndent = False     .ShrinkToFit = False     .ReadingOrder = xlContext     .MergeCells = False     With .FormatConditions       .Delete       .Add(Type:=xlExpression, Formula1:="=AND(NOT(ISBLANK($A3)),ISBLANK($R3))").Interior.ThemeColor = xlThemeColorAccent5       .Add(Type:=xlExpression, Formula1:="=AND(NOT(ISBLANK($A3)),NOT(ISBLANK($D3)))").Interior.Color = 5296274       With .Add(Type:=xlExpression, Formula1:="=AND(NOT(ISBLANK($A3)),ISBLANK($L3))").Interior         .Color = 65535         .Pattern = xlSolid       End With     End With   End With End Sub 基本、Selectなしで処理できます。 それに条件付書式を設定する範囲が決まっているなら、前レスでのR1C1形式での処理は必要ありません。 ただ、バージョン2007の場合はコメントアウトしている 'Range("A3").Activate が必要です。アクティブセルの位置によって数式がずれてしまいます。 2010はその点が改善されているため必要ないです。 『答え合わせ』 別に上記コードが正解ではないです。 自分を含め利用者が理解できてメンテナンスし易く、 目的通り動いてくれるコードならそれで構わないと思いますよ。

kichi4182
質問者

お礼

大変わかりやすい回答を何度もありがとうございます。 > Range("A:F").Columns.AutoFit ここですが、該当ブック使用者が意図する・意図しないにかかわらず、必要な幅以下にしてしまった時に、 .WrapText = False       '折り返し解除 になっていないと、狭い幅でAutofitされてしまうので、 >Range(Columns(1), Columns(mx)).ColumnWidth = 30# を入れていたのですが、折り返し介助を先にすれば、幅を30にする処理は必要無いのでしょうか。 あと、使用者は複数人居り、使用パソコンも使用ソフト(OS/OFFICE)もバラバラです。バージョン2007もあると思いますが、僕は2010です。 'Range("A3").Activate は、有効にした方が良いですよね? 'Range("$A$3").Activateとしなくても良いでしょうか。何度も申し訳ありません。

その他の回答 (3)

  • end-u
  • ベストアンサー率79% (496/625)
回答No.4

>ここですが、該当ブック使用者が意図する・意図しないにかかわらず、必要な幅以下にしてしまった時に、 >: >を入れていたのですが、折り返し介助を先にすれば、幅を30にする処理は必要無いのでしょうか。 そうですね。先に折り返しを解除すれば良いかと思います。 別に設定しても差し支えないとも思いますけれども。 処理する場合は全列ではなくて、A:F列で良いはずですね。 With Range("A:F")   .ColumnWidth = 30   .Columns.AutoFit End With G列以降は固定値と非表示に設定しますから。 >あと、使用者は複数人居り、使用パソコンも使用ソフト(OS/OFFICE)もバラバラです。.. という事であれば Range("A3").Activate は必要です。 または#1のコードで書いたR1C1形式での設定に変更するかですね。 "A3"指定に関しては、数式ではないので相対参照や絶対参照は関係ありません。 $つけてもエラーになりませんが無視されます。 また、ver2003もあるようなら、ThemeColorプロパティは2007で追加されたプロパティなので使えません。 変更する必要があります。

  • end-u
  • ベストアンサー率79% (496/625)
回答No.3

あ、失礼.. >With Range("A1:A2,B1:B2,C1:C2,D1:D2,E1:E2,F1:F2,G1:G2,H1:H2,I1:I2,J1:J2," & _ >    "K1:K2,L1:L2,M1:M2,N1:O1,P1:Q1,R1:S1,T1:U1,V1:W1,X1:Y1,Z1:AA1," & _ >    "AB1:AC1,AD1:AE1,AF1:AG1,AH1:AI1,AJ1:AK1,AL1:AM1,AN1:AO1") >  .HorizontalAlignment = xlDistributed >  .VerticalAlignment = xlCenter >  .WrapText = False >  .Orientation = 0 >  .AddIndent = True >  .IndentLevel = 0 >  .ShrinkToFit = False >  .ReadingOrder = xlContext >  .MergeCells = True >End With これだとN2:AO2の書式設定が漏れますね。 結合時のエラー対策含めて.. With Range("A1:AO2")   .HorizontalAlignment = xlDistributed   .VerticalAlignment = xlCenter   .WrapText = False   .Orientation = 0   .AddIndent = True   .IndentLevel = 0   .ShrinkToFit = False   .ReadingOrder = xlContext End With Application.DisplayAlerts = False Range("A1:A2,B1:B2,C1:C2,D1:D2,E1:E2,F1:F2,G1:G2,H1:H2,I1:I2,J1:J2," & _    "K1:K2,L1:L2,M1:M2,N1:O1,P1:Q1,R1:S1,T1:U1,V1:W1,X1:Y1,Z1:AA1," & _    "AB1:AC1,AD1:AE1,AF1:AG1,AH1:AI1,AJ1:AK1,AL1:AM1,AN1:AO1").MergeCells = True Application.DisplayAlerts = True : こうかな。

  • end-u
  • ベストアンサー率79% (496/625)
回答No.1

Sub sample()   Dim ref As Long   ref = Application.ReferenceStyle   Application.ReferenceStyle = xlR1C1   If TypeName(Selection) <> "Range" Then Exit Sub   With Selection     .Phonetics.Visible = False   'フリガナ表示をオフに     .VerticalAlignment = xlCenter '縦位置中央     .WrapText = False       '折り返し解除     .Orientation = 0        '文字の向き     .AddIndent = False       'インデント解除     .ShrinkToFit = False      '縮小表示解除     .ReadingOrder = xlContext   '文字読込み順解除(日本語では不要だと思う)     .MergeCells = False      '結合解除     With .FormatConditions       .Delete          '既設定の条件付書式を削除       .Add(Type:=xlExpression, Formula1:="=AND(NOT(ISBLANK(RC1)),ISBLANK(RC18))").Interior.ThemeColor = xlThemeColorAccent5       .Add(Type:=xlExpression, Formula1:="=AND(NOT(ISBLANK(RC1)),NOT(ISBLANK(RC4)))").Interior.Color = 5296274       .Add(Type:=xlExpression, Formula1:="=AND(NOT(ISBLANK(RC1)),ISBLANK(RC12))").Interior.Color = 65535     End With   End With   Application.ReferenceStyle = ref End Sub ..こんな感じで良いかと思われます。 .WrapTextなどの書式設定の箇所は、既に設定されていたらそれを解除するコードなので、 考慮する必要が無い新規シートなどでは割愛できます。 コードを実行する作業環境に合わせて判断してください。 .FormatConditions.Delete は既に条件付書式が設定されていたらそれを削除するコードです。 既設定を生かして条件を常に追加する場合は .Delete は削除してください。 元コードの.SetFirstPriority は優先順位を1番目にする設定ですので、 最後に追加した条件の優先順位が高くなります。 逆に優先順位が高い順番に.Addすれば設定不要です。 .PatternColorIndex や .TintAndShade などは既定の設定だから不要と判断しましたが、 別途設定する必要がある時は With .Add(Type:=xlExpression, Formula1:="=AND(NOT(ISBLANK(RC1)),ISBLANK(RC12))").Interior   .Color = 65535   .Pattern = xlSolid End With ..のようにしてください。 .StopIfTrue = False「条件を満たす場合は停止」しない設定は、 今回の場合は.Interior(背景色)の設定のみで、実質効果がないので不要だと思われます。 さて。 Dim ref As Long ref = Application.ReferenceStyle Application.ReferenceStyle = xlR1C1 : Application.ReferenceStyle = ref この箇所がややこしいのですが... 実は『Selection』、つまりコード実行前に選択しているセルに対して設定する場合、 例えば10行目を選択して .Add(Type:=xlExpression, Formula1:="=AND(NOT(ISBLANK($A3)),ISBLANK($R3))").Interior.ThemeColor = xlThemeColorAccent5 ..とやってしまっていいものかどうか、という問題があります。 $A3、$R3、と指定されているという事は列固定で行は相対指定したいという事ですよね。 その場合、数式をR1C1形式で設定するという方法があります。 "=AND(NOT(ISBLANK($A3)),ISBLANK($R3))" ↓ "=AND(NOT(ISBLANK(RC1)),ISBLANK(RC18))" 2003以前のバージョンはこれで自動的にR1C1形式で指定されているんだな、とExcel君が判別してくれていたんですが 2007以降だと A1形式のRC列なのか、行相対でA列固定のR1C1形式なのか判別できません。 そこで Dim ref As Long ref = Application.ReferenceStyle 最初に、現在の列表示形式を変数refに控えておいて Application.ReferenceStyle = xlR1C1 R1C1形式にして条件付書式を設定し、終わったら Application.ReferenceStyle = ref 控えておいた元の形式に戻す処理をしてます。 もっとも、必ず3行目からセルを選択して実行する、という事が保証されるなら不要な処理ですが。 そのコードだけでは判断できませんので念のため入れました。 If TypeName(Selection) <> "Range" Then Exit Sub ..これも、セルではなく図形やグラフを選択して実行すればエラーになるので、その予防で念のため入れました。

kichi4182
質問者

お礼

早速の丁寧な回答と解説ありがとうございます。大変分かり易かったです。また、回答中の注釈も、開発者が変わったとしても分かりやすいものだと思います。本当にありがとうございました。 元コードは Worksheet_Activate()の一部であり、当該コードの前の部分で、 ' 選択セル位置の割り出し row = ActiveCell.row: column = ActiveCell.column max = Rows.Count: mx = Columns.Count Worksheets("予約状況").Unprotect Range("A1:A2,B1:B2,C1:C2,D1:D2,E1:E2,F1:F2,G1:G2,H1:H2,I1:I2,J1:J2,K1:K2,L1:L2,M1:M2,N1:O1,P1:Q1,R1:S1,T1:U1,V1:W1,X1:Y1,Z1:AA1,AB1:AC1,AD1:AE1,AF1:AG1,AH1:AI1,AJ1:AK1,AL1:AM1,AN1:AO1").Select With Selection .HorizontalAlignment = xlDistributed .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = True .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With Range("A1:AO2").Select With Selection .HorizontalAlignment = xlDistributed .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = True .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext End With 'Cells.EntireRow.Hidden = True 'Cells.EntireColumn.Hidden = True Rows("1:2").RowHeight = 17# Rows("3:" & max).RowHeight = 25# Range(Columns(1), Columns(mx)).ColumnWidth = 30# Columns("AP").ColumnWidth = 0.2 Columns("A:M").EntireColumn.AutoFit Columns("G:K").ColumnWidth = 8# Range("B:C,L:M").ColumnWidth = 21# Columns("N:AO").ColumnWidth = 23# Range(Columns("AQ"), Columns(mx)).EntireColumn.Hidden = True ActiveWindow.FreezePanes = False Range("A1").Activate Range("A1").Select Range("D3").Select ActiveWindow.FreezePanes = True Range("O:O,Q:Q,S:S,U:U,W:W,Y:Y,AA:AA,AC:AC,AE:AE,AG:AG,AI:AI,AK:AK,AM:AM,AO:AO").ColumnWidth = 9# Cells.FormatConditions.Delete '----------------------------------------------------------------------------------------------------- Range(Cells(3, 1), Cells(max, 41)).Select ' Range("A3:AO1048576").Select としてあるのです。因みに1~2行目はタイトル行にしてあります。ここも、無駄なコードってありますか?自分でも見てみますので、答え合わせの意味で教えて頂けるとありがたいです。 今回教えて頂いたことを参考にもっと勉強しようと思います。ありがとうございます

関連するQ&A

専門家に質問してみよう