プロが教えるわが家の防犯対策術!

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 'この行まで

A 回答 (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
「エクセル重複行統合マクロの意味」の回答画像3

この回答への補足

捕捉になってしまいましたが、
関数クリアはselection.value=selection.value
のようなマクロで簡単に削除できそうですね。

補足日時:2014/07/24 01:21
    • good
    • 0
この回答へのお礼

感激です^^!お陰様でようやくできました。
Dの項目列の重複文字が消えなく、どうしてかと考えていましたが、
どうやら、関数がi~Oに入力されているためのようでした。
一度関数をクリアして数値のみにするために、シートの使っていないところに値のコピーをして表に戻してからのマクロ実行にしようかと思います。
ありがとうございました。
もっと勉強しないとと感じました。
関数のクリアは他に良い方法ありますでしょうか?

お礼日時:2014/07/24 01:15

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
    • good
    • 0
この回答へのお礼

ありがとうございます。
実行してみたところ、L列の1箇所の統合に成功しましたが、
他の重複項目行の数字の移動と
重複項目行の削除が行われませんでした。
原因が分かりませんが修復可能でしょうか?
教えてください。

お礼日時:2014/07/23 00:52

こんばんは!



かなり以前に当方が投稿したコードだと思いますが、
大きな間違いをしています。
変数の宣言部分で
>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以降の列にあります。
どうぞよろしくお願いします。

補足日時:2014/07/22 23:15
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!