|
▼Aoichi さん:
シートレイアウトはコードから想像していますので誤解ある可能性はあります。
また、転記レイアウトもよくわかりませんでしたので、以下のコードでは
転記先のC3以下に表示しています。
Sub 重複2()
Dim x As Long
Dim myA As Range
Dim myW As Range
Dim dupV() As String
Dim k As Long
Dim c As Range
With Sheets("重複data")
'現在の使用領域の外側に作業域を
x = .UsedRange.Cells(.UsedRange.Cells.Count).Column + 2
'現在のリスト領域
Set myA = .Range("C3", .Range("C" & .Rows.Count).End(xlUp))
'現在のリストからフィルターオプションで重複を排除した一覧を作成
myA.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, x), Unique:=True
'重複を排除した領域(タイトルを除く)
With .Cells(1, x).CurrentRegion
Set myW = .Offset(1).Resize(.Rows.Count - 1)
End With
End With
ReDim dupV(1 To myW.Rows.Count, 1 To 1) '重複リスト用配列
For Each c In myW
If WorksheetFunction.CountIf(myA, c.Value) > 1 Then
k = k + 1
dupV(k, 1) = c.Value
End If
Next
If k = 0 Then
MsgBox "重複のデータはありませんでした"
Else
With Sheets("重複一覧")
.Range("C3:C" & .Rows.Count).ClearContents
.Range("C3").Value = "重複データ"
.Range("C4").Resize(k).Value = dupV
.Select
End With
MsgBox "重複データをピックアップしました"
End If
End Sub
|
|