Xin hỏi Cách Xóa dòng trùng bằng macro trên Excel 2003

Liên hệ QC

kinhvan69

Thành viên mới
Tham gia
15/3/10
Bài viết
14
Được thích
1
Dear các anh chị trong diễn đàn giải pháp excel

Em có 1 bài toán khó quá mà giải mãi không được đành nhờ các cao nhân cứu giúp vì thật sự gấp gáp rồi **~**

chẳng là em đã tạo được 1 macro bên excel 2007 như sau:

Sub Macro1()
'
' Macro1 Macro
'

'
ActiveSheet.Range("$A$7:$J$8008").RemoveDuplicates Columns:=3, Header:= _
xlYes
End Sub

Nhưng Qua 2003 nó không chạy các bác ạ.

Mục tiêu của em là tìm trong cột C (cột mã hàng hóa)
có mã hàng nào lặp lại thì xóa nó đi
vấn đề là bảng dữ liệu của em chưa có (nó sẽ chạy ra theo range ) nên ko dùng công thức đơn thuần được

VD: ở cột C
A
B
C
D
F
A
F

phải tạo macro quét cột C, tìm thấy dữ liệu trùng thì xóa cả dòng đi

thành:
A
B
C
D
F


Em gà VBA lắm nên cao nhân nào quá bộ ghé ngang giúp em với ạ. excel 2003 phải chạy được cơ )(&&@@
 
Đã gấp gáp sao không gửi cái mẫu data lên tránh sửa đi sửa lại
 
Upvote 0
dạ, của em đây ạ, bác xem dùm em với, cám ơn bác

Khi trích dữ liệu từ một nguồn nào đó, tôi nghĩ bạn để riêng trên 1 sheet, sau đó từ nguồn dữ liệu trên sheet đó chuyển qua biểu mẫu của bạn.

PHP:
Sub Macro1()
  Dim MyRng As Range
  Set MyRng = Range(SheetNguon.[C1], SheetNguon.[C65536].End(xlUp))
  If WorksheetFunction.CountA(MyRng) = 1 Then GoTo ExitSub
  BaoCaoHS.[A8:J65536].ClearContents
  With MyRng
    .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    .Offset(1, -1).Resize(, 9).Copy
  End With
  With BaoCaoHS
    .[B8].PasteSpecial 3
    .[A8] = 1
    .[A8].AutoFill Destination:=Range(.[A8], .Range("A" & .[C65536].End(xlUp).Row)), Type:=xlFillSeries
  End With
  SheetNguon.ShowAllData
ExitSub:
  Set MyRng = Nothing
End Sub

Tôi làm cho bạn File mẫu dưới đây, bạn xem có đúng ý bạn không.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Bạn thay code này vào nha

Mã:
Sub Macro1()
Dim Rng As Range, Cl As Range, Tam()
Dim MaHS As New Collection
Dim i, j, n As Integer
Set Rng = Sheet2.Range("C8:C" & _
Sheet2.[C65000].End(3).Row)
On Error Resume Next
For Each Cl In Rng
MaHS.Add Cl.Value, CStr(Cl.Value)
Next Cl
ReDim Tam(1 To MaHS.Count, 1 To 10)
For i = 1 To MaHS.Count
Set Cl = Rng.Find(MaHS(i))
j = 1 + j
Tam(j, 1) = j
Tam(j, 2) = Cl.Offset(, -1).Value
Tam(j, 3) = Cl.Value
For n = 1 To 7
Tam(j, 3 + n) = Cl.Offset(, n).Value
Next n
Next i
Sheet2.[A8:J2000].ClearContents
Sheet2.[A8].Resize(j, 10) = Tam
End Sub
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom