[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『重複チェックマクロ』(太郎)
下記でやっても、「全3行の重複チェックを開始します」→重複があっても結果が出ない、になります。
何故なんでしょう?
因みにデータを20行くらい入れてあり、重複もあります。
Sub DuplicateCheck()
Dim EndRow As Integer 'データの最終行
Dim SetColumn As String 'チェックの対象列
'(1)処理をする列を指定する
SetColumn = "M" '★TODO:Namingが入っている列を指定して下さい。例えば、D列を指定するなら SetColumn = "D"
'(2)Namingの列に入っているデータの最終行を求める
EndRow = ActiveSheet.Range(SetColumn & ":" & SetColumn).End(xlDown).Row MsgBox ("全" & EndRow & "行の重複チェックを開始します")
'(3)重複チェックを開始
Dim i As Long For i = 1 To EndRow
If WorksheetFunction.CountIf(Range(SetColumn & "1:" & SetColumn & EndRow), Range(SetColumn & i)) > 1 Then Range(SetColumn & i).Interior.ColorIndex = 22 MsgBox (i - 1 & "行目にNamingの重複があります") End If
Next i
MsgBox ("重複チェックが完了しました")
End Sub
< 使用 Excel:Excel2010、使用 OS:Windows7 >
全3行 とは何のことですか? いずれにしても、○行目にNaming云々の○が1つずれていますが、重複チェックはされますし 色も付きます。 該当列には20行ぐらいデータがあるのでは? それがメッセージで 全3行 とでてくるということは、実際にデータをつくったのはM列ではないのでは?
あぁ、つでに、1回実行して色がつく。 で、値を変更して2回目実行するかもしれませんね。 そうすると前回の色がついたままですね。
この種の処理、マクロの最初で該当列の色を消しておくほうがいいですよ。
(β) 2015/06/25(木) 19:59
(マナ) 2015/06/25(木) 20:04
マナさん
End(xlUp)とすると、今度は「全1行・・・」となってしまいます。
メッセージも正しい最終行を取得しないのですが、重複チェックすらかかりません。。
(太郎) 2015/06/25(木) 20:15
(マナ) 2015/06/25(木) 20:35
このマクロを同じbookの新しいsheetでA列にテストデータを入れて実行してみました。
するとちゃんとマクロが正しく動きます。
本来動かしたい沢山データの入ったsheetだと動きません。(M列を指定しています)
つまり、このシートに何か問題があるのでしょうか?
太郎
(太郎) 2015/06/25(木) 20:39
>>このマクロを同じbookの新しいsheetでA列にテストデータを入れて実行してみました。 >>するとちゃんとマクロが正しく動きます。
A列? マクロは M列を処理してますよ?
現在の(おかしいといわれる)シートで以下を実行してみてください。 どうなりますか? 処理すべき列は、マクロ内で出てくるダイアログで、セル選択してください。
Sub Test() Dim col As Range Dim EndRow As Long Dim SetColumn As String 'チェックの対象列 Dim wCol As Long Dim r As Range
On Error Resume Next Set col = Application.InputBox("処理する列の任意のセルを選択してください", Type:=8) On Error GoTo 0
If col Is Nothing Then Exit Sub 'キャンセルボタン '複数セル領域が選択されても最初のセルの列のみを処理 SetColumn = Split(col.Cells(1).Address, "$")(1) '事前に該当列の背景色を消去 Columns(SetColumn).Interior.ColorIndex = xlNone EndRow = Columns(SetColumn).End(xlDown).Row '未使用域を作業域に使用 wCol = Range("A1", ActiveSheet.UsedRange).Columns.Count + 2
Cells(1, wCol).Resize(EndRow).Formula = "=IF(COUNTIF(" & SetColumn & "$1:" & SetColumn & "$" & EndRow & "," & SetColumn & 1 & ")>1,#N/A,"""")"
On Error Resume Next Set r = Columns(wCol).SpecialCells(xlCellTypeFormulas, 16) On Error GoTo 0
'作業列のクリア Columns(wCol).Clear
If r Is Nothing Then MsgBox "重複はありません" Else r.Offset(, Columns(SetColumn).Column - wCol).Interior.ColorIndex = 22 MsgBox r.Count & "個の重複がありました" & vbLf & Replace(r.Address(False, False), ",", vbLf) End If
End Sub
(β) 2015/06/25(木) 20:43
太郎
(太郎) 2015/06/25(木) 20:44
太郎
(太郎) 2015/06/25(木) 20:48
つまり、やはりおかしいシートに、何か問題があるようです。
それが、何か分からなくて困るんですが。。
太郎
(太郎) 2015/06/25(木) 20:51
(マナ) 2015/06/25(木) 21:07
>>なるほどM2が空欄だからですね
ふふふ(失礼)。 ですね!
To 太郎さん
やはり End(xlup) でやりましょう。ただし、列指定では具合悪いです。 私のコードでも太郎さんのコードでも
EndRow = Range(SetColumn & Rows.Count).End(xlUp).Row
(β) 2015/06/25(木) 21:13
っていうか・・・・なんだか申し訳ありませんでした。
実は会社の別の人が作ったマクロをコピって使用しているんです。
とにかく助かりました!!!
ありがとうございました。
太郎
(太郎) 2015/06/25(木) 21:19
(太郎) 2015/06/25(木) 22:06
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.