VBA：移除所有重複資料的簡單應用

 一般移除重複，透是透過RemoveDuplicates 這各RANGE的方法作執行，但如果要移除所有重複呢!!

今天早上M01某網友貼文，我簡單回了他，但是發現他的問題就是要移除所有重複。

小編分享自己目前手上有得副程式，主要是透過搜尋，把所有重複"資料"的位置找出來，作任何你想要的處理，例如刪除資料。

	COPYRIGHT BY dropit.liu.
	Function 找重複值的位置(SHEET_NAME, Target, ADD_ROW, ADD_COLUMN, range_to_range As String)
	'SHEET_NAME: 搜尋表單名
	'TARGET: 找尋的目標值
	'ADD_ROW: ROW增值
	'ADD_COLUMN: COLUMN增值
	'2018.5.18 增加當無重複時自動離開迴圈
	SHEET_NAME_A = SHEET_NAME
	合計_add = 0
	Set M_RNFIND = Sheets(SHEET_NAME_A).Range(range_to_range).Find(WHAT:=Target)
	If Not M_RNFIND Is Nothing Then
	m_stAddress = Sheets(SHEET_NAME_A).Cells(M_RNFIND.Row + ADD_ROW, M_RNFIND.Column + ADD_COLUMN).Address
	Do
	Set M_RNFIND = Sheets(SHEET_NAME_A).Range(range_to_range).FindNext(M_RNFIND)
	If M_RNFIND Is Nothing Then
	Exit Do
	End If
	If Target = Sheets(SHEET_NAME_A).Range(M_RNFIND.Address) Then
	合計_add = 合計_add + 1
	End If
	Loop While Not M_RNFIND Is Nothing And M_RNFIND.Address <> m_stAddress
	ReDim 合計(合計_add)
	合計_add = 0
	'AGAIN
	m_stAddress = ""
	Set M_RNFIND = Sheets(SHEET_NAME_A).Range(range_to_range).Find(WHAT:=Target)
	If Not M_RNFIND Is Nothing Then
	'm_stAddress = m_rnFind.Address
	合計(合計_add) = M_RNFIND.Address
	'Unhide the column, and then find the next X.
	Do
	If Target = Sheets(SHEET_NAME_A).Range(M_RNFIND.Address) Then
	合計(合計_add) = Sheets(SHEET_NAME_A).Cells(M_RNFIND.Row + ADD_ROW, M_RNFIND.Column + ADD_COLUMN).Address
	End If
	' TARGET_LEN = Len(Sheets(SHEET_NAME_A).Cells(M_RNFIND.Row + ADD_ROW, M_RNFIND.Column + ADD_COLUMN))
	Set M_RNFIND = Sheets(SHEET_NAME_A).Range(range_to_range).FindNext(M_RNFIND)
	If M_RNFIND Is Nothing Then
	Exit Do
	End If
	If Target = Sheets(SHEET_NAME_A).Range(M_RNFIND.Address) Then
	合計_add = 合計_add + 1
	End If
	BV = Filter(合計, M_RNFIND.Address)
	If UBound(BV) >= 0 Then
	Exit Do
	End If
	Loop While Not M_RNFIND Is Nothing And M_RNFIND.Address <> m_stAddress
	End If
	End If
	If Val(合計_add) = 0 Then
	找重複值的位置 = 0
	Exit Function
	End If
	找重複值的位置 = 合計
	End Function

view raw gistfile1.txt hosted with ❤ by GitHub

設定以下參數即可運作：

SHEET_NAME, Target, ADD_ROW, ADD_COLUMN, range_to_range As String

SHEET_NAME：要搜尋的工作表名；EX:ACTIVESHEET.NAME OR "SHEET1"

Target：要搜尋的關鍵字,EX:"P10"

ADD_ROW：搜尋到資料時後，指定抓的列數的加減數；EX:1,-1

ADD_COLUMN：搜尋到資料時後，指定抓的行數的加減數；EX:1,-1

range_to_range ：要搜尋那一列；EX:"A:A"

例如類似M01這位的問題，我自己作一個簡單的DEMO，作一個按鈕插入如下的CODE跟上面的副程式。

	Private Sub CommandButton1_Click()
	OUT = 找重複值的位置(ActiveSheet.Name, "P10", 0, 0, "A:A")
	For Each A In OUT
	If A <> "" Then
	ActiveSheet.Range(A) = ""
	End If
	Next
	End Sub

view raw gistfile1.txt hosted with ❤ by GitHub

圖1.

P.S資料在A行中。