[發問] 清除重覆資料,只存留1筆資料

linsurvey2005

請問資料比對
核對B欄,C欄,D欄都相同,才刪除重複資料,資料整理後只要存留1筆資料

下載 (15.44 KB)

2016-10-24 12:42

starbox520

回復 1# linsurvey2005

EXCEL->資料 ->移除重複

linsurvey2005

回復 2# starbox520


感謝回覆
因為資料B C D欄同時相同情況,屬於1筆資料
但全部資料只能存在1筆,所以我沒辦法這樣子處理
請問有其他方式嗎?

rouber590324

如下為版內前輩之作品.試試

Sub ab()
    Dim arr As Variant
    Dim t As Range
    Dim s As New Collection
    Dim i, j As Long
    Dim myRng As Range
    j = [B65536].End(xlUp).Row
    Set myRng = Range("B1:B" & j)
    On Error Resume Next
    For Each t In myRng
        s.Add Item:=Range(t, t.Offset(0, 2)), key:=CStr(t)
    Next
    ReDim arr(1 To s.Count)
    For i = 1 To s.Count
        [f65536].End(xlUp).Offset(1, 0).Resize(, 3) = s(i).Value
    Next
End Sub

linsurvey2005

回復 4# rouber590324

謝謝回覆
執行之後會有誤刪的情形,如下說明:
因為1筆資料 有"編號" "E" "N" "ELE"(1列)
所以 B C D 三個欄位Matc才清除重複資料

如果只比對B欄位,那麼C D欄位沒有Match情況下,資料可能誤刪
請教可有他山

rouber590324

我會創造一欄將  "E"&"N"&"ELE" 資料串一欄
然後以如上程式比對不重覆秀出.
已16:54-要下班啦-明日休假-無時間修改程式-自己試試啦

GBKEE

回復 6# rouber590324

試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng(1 To 2) As Range
   
4.      Set Rng(1) = ActiveSheet.Range("a1").CurrentRegion  '資料所在的範圍
   
5.      Set Rng(2) = ActiveSheet.Cells(1, Columns.Count - Rng(1).Columns.Count)
   
6.      With Rng(1)
   
7.         .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=.Range("B1:D1"), Unique:=True
   
8.         'Rng(1)的進階篩選:,  範圍中的 B:D 欄,不重複的資料
   
9.         .Copy Rng(2)
   
10.         .AdvancedFilter xlFilterInPlace    '全部資料顯示
    
11.         .Cells.Clear
    
12.        End With
    
13.        Rng(2).CurrentRegion.Copy Rng(1)(1)
    
14.        Rng(2).Clear
    
15. End Sub

複製代碼

linsurvey2005

回復 7# GBKEE


G大好
執行後狀況很奇怪
原始資料A:D欄 複製到B:E欄
A欄資料留下原始的幾個編號
感覺沒有比對

我需要的資料是點位坐標與高程資料
因為座標不能重複 因此需要刪除重複點位
可是有些點位的E值會一模一樣,因此要比對N值,又可能E值跟N值都一模一樣,所以必須比對ELE值
以上

hcm19522

http://blog.xuite.net/hcm19522/twblog/225435151
參考~
http://blog.xuite.net/hcm19522/twblog/458258396

准提部林

編號78與5只有C.D欄相同, 為何只保留5???
VBA問題最好上傳附檔!!