Xoá dữ liệu không trùng trong cùng một cột

[hcl_pt]

Mong GPE giúp đỡ trường hợp này với ạ: Xoá những dữ liệu không trùng với dữ liệu đầu tiên ở trong cùng cột.
Ví dụ ở cột 2: dữ liệu đầu tiên là 68, những dữ liệu trong cột 2 mà không trùng với 68 thì xoá, còn dữ liệu nào mà trùng thì giữ lại! Kết quả xuất sang sheet2!
Xin cảm ơn rất nhiều!

 

[SA_DQ]

Option Explicit
Sub XoaKhongTrung()
 Dim Arr(), Tmp As Integer
 Dim J As Long, W As Integer

1 Arr = [B4].CurrentRegion.Value
 ReDim dArr(1 To UBound(Arr()), 1 To UBound(Arr(), 2))
3 For W = 1 To UBound(Arr(), 1)
    Tmp = Arr(1, W):            dArr(1, W) = Arr(1, W)
5   For J = 2 To UBound(Arr()) - 1
        If Arr(J, W) = Tmp Then
7            dArr(J, W) = Arr(J, W)
        End If
9    Next J
 Next W
11 Sheet2.Cells(4, "B").Resize(J, W).Value = dArr()
End Sub

 

[babyheomoi]

Có ai giải thích cthuc mảng của bác sadq ko?

 

[hcl_pt]

Option Explicit
Sub XoaKhongTrung()
 Dim Arr(), Tmp As Integer
 Dim J As Long, W As Integer

1 Arr = [B4].CurrentRegion.Value
 ReDim dArr(1 To UBound(Arr()), 1 To UBound(Arr(), 2))
3 For W = 1 To UBound(Arr(), 1)
    Tmp = Arr(1, W):            dArr(1, W) = Arr(1, W)
5   For J = 2 To UBound(Arr()) - 1
        If Arr(J, W) = Tmp Then
7            dArr(J, W) = Arr(J, W)
        End If
9    Next J
 Next W
11 Sheet2.Cells(4, "B").Resize(J, W).Value = dArr()
End Sub

Cảm ơn bác SA_DQ và GPE rất nhiều!

 

[ChanhTQ@]

Sẵn lòng thôi:

Có ai giải thích các lệnh của macro mà bác sadq xài ko?

Hai dòng lệnh trước dòng 1: Khai bào các biến cần dùng; Trong đó:
Dòng đầuu: Khai 1 biến mảng (Để chứa toàn bộ số liệu nguồn) & 1 biến tạm (để sau này ghi số liệu đầu cột)
Dòng sau: Khai báo 2 biến đếm cho vòng lặp
D1: Gán toèn bộ số liệu đề bài vô mảng đã khai báo;
D2: Khai báo thêm 1 biến mảng (dùng để chứa dữ liệu thu được từ việc khảo sát các thành tố trong vòng lặp);
D3:Lập vòng lặp duyệt theo các cột dữ liệu; Fải duyệt theo cột trước, iêu cầu đề bài là tìm các số không trùng với số liệu đầu cột; Vòng lặp này kết thúc ở D10.
D4: Mệnh đề đầu: Lưu số liệu đầu cột vô biến tạm;
Mệnh đề sau: Ghi số liệu đầu cột vô biến mảng (đích) đã khai báo
D5: Tạo vòng lặp tiếp theo để duyệt lần lượt các hàng trong từng cột đang duyệt (bỡi vòng lặp trước)
Vòng lặp này kết thúc ở D9
& ta chỉ duyệt từ hàng thứ 2 trở xuống, do hàng đầu ta đã xử lí rồi (bên trên)
D6: Điều kiện, nếu Trị trong cột & hàng đang duyệt trùng với biến tạm (lưu giữ trị số đầu cột hiện hành) thì thực hiện lệnh ngay tiếp sau
Điều kiện này kết thúc ở D8
D7: Ghi số liệu hàng & cột đang duyệt vô mảng đích (mảng chứa kết quả)

Những mong giúp được bạn ít nhiều.
& nói rõ thêm là: Dịch từ ngôn ngữ VBA sang tiếng Việt thôi;. . . .

 

[Lê Duy Thương]

Hai dòng lệnh trước dòng 1: Khai bào các biến cần dùng; Trong đó:
Dòng đầuu: Khai 1 biến mảng (Để chứa toàn bộ số liệu nguồn) & 1 biến tạm (để sau này ghi số liệu đầu cột)
Dòng sau: Khai báo 2 biến đếm cho vòng lặp
D1: Gán toèn bộ số liệu đề bài vô mảng đã khai báo;
D2: Khai báo thêm 1 biến mảng (dùng để chứa dữ liệu thu được từ việc khảo sát các thành tố trong vòng lặp);
D3:Lập vòng lặp duyệt theo các cột dữ liệu; Fải duyệt theo cột trước, iêu cầu đề bài là tìm các số không trùng với số liệu đầu cột; Vòng lặp này kết thúc ở D10.
D4: Mệnh đề đầu: Lưu số liệu đầu cột vô biến tạm;
Mệnh đề sau: Ghi số liệu đầu cột vô biến mảng (đích) đã khai báo
D5: Tạo vòng lặp tiếp theo để duyệt lần lượt các hàng trong từng cột đang duyệt (bỡi vòng lặp trước)
Vòng lặp này kết thúc ở D9
& ta chỉ duyệt từ hàng thứ 2 trở xuống, do hàng đầu ta đã xử lí rồi (bên trên)
D6: Điều kiện, nếu Trị trong cột & hàng đang duyệt trùng với biến tạm (lưu giữ trị số đầu cột hiện hành) thì thực hiện lệnh ngay tiếp sau
Điều kiện này kết thúc ở D8
D7: Ghi số liệu hàng & cột đang duyệt vô mảng đích (mảng chứa kết quả)

Những mong giúp được bạn ít nhiều.
& nói rõ thêm là: Dịch từ ngôn ngữ VBA sang tiếng Việt thôi;. . . .

Sao code này chạy cũng ra kết quả mà còn độc chiêu hơn code của bác SA_DQ là thấy được nó chạy Nha bác CHANH@TQ

Sub thaycodechay()
Dim i As Long, Endr As Long, clls As Range, Irange As Range
 Sheet1.Range("B4").CurrentRegion.Copy Sheet2.Range("B4")
     Endr = Sheet1.Range("B4").CurrentRegion.Rows.Count
      For i = 1 To Sheet2.Range("b4").CurrentRegion.Columns.Count
       Set Irange = Sheet2.Range("A5").Resize(Endr, 1).Offset(, i)
        For Each clls In Irange
         If clls.Value <> Sheet2.Range("a4").Offset(0, i).Value Then
        clls.Clear
        End If
       Next
     Next
End Sub

 

[hcl_pt]

Option Explicit
Sub XoaKhongTrung()
 Dim Arr(), Tmp As Integer
 Dim J As Long, W As Integer

1 Arr = [B4].CurrentRegion.Value
 ReDim dArr(1 To UBound(Arr()), 1 To UBound(Arr(), 2))
3 For W = 1 To UBound(Arr(), 1)
    Tmp = Arr(1, W):            dArr(1, W) = Arr(1, W)
5   For J = 2 To UBound(Arr()) - 1
        If Arr(J, W) = Tmp Then
7            dArr(J, W) = Arr(J, W)
        End If
9    Next J
 Next W
11 Sheet2.Cells(4, "B").Resize(J, W).Value = dArr()
End Sub

GPE có thể giải thích hộ mình sao code này mình chỉ chạy được với dữ liệu số cột tối đa là 173 cột? Xin cảm ơn!

 

[HieuCD]

GPE có thể giải thích hộ mình sao code này mình chỉ chạy được với dữ liệu số cột tối đa là 173 cột? Xin cảm ơn!

bạn chạy code nầy xem sao, chắc chắn chậm hơn code của bạn SA_DQ, nếu chạy được mới có thể đoán được lý do bạn hỏi

Sub XoaKhongTrung()
  Dim Rng As Range
  Sheet2.Cells.ClearContents
  For Each Rng In Sheet1.[B4].CurrentRegion
    If Rng = Sheet1.Cells(4, Rng.Column) Then Sheet2.Cells(Rng.Row, Rng.Column) = Rng
  Next
  Set Rng = Nothing
End Sub

 

[SA_DQ]

GPE có thể giải thích hộ mình sao code này mình chỉ chạy được với dữ liệu số cột tối đa là 173 cột? Xin cảm ơn!

Vậy toàn bộ các ô trong cột 174 có xíu dữ liệu nào không?

Nếu không thì fải từ bỏ CurrentRegion, mà chuyển qua xài UsedRange cũng nên.

 

[ducmxd]

xin hoỉ: nếu xóa không trùng trông 2 bảng thì sao?

bạn chạy code nầy xem sao, chắc chắn chậm hơn code của bạn SA_DQ, nếu chạy được mới có thể đoán được lý do bạn hỏi

Sub XoaKhongTrung()
  Dim Rng As Range
  Sheet2.Cells.ClearContents
  For Each Rng In Sheet1.[B4].CurrentRegion
    If Rng = Sheet1.Cells(4, Rng.Column) Then Sheet2.Cells(Rng.Row, Rng.Column) = Rng
  Next
  Set Rng = Nothing
End Sub

 

[HieuCD]

xin hoỉ: nếu xóa không trùng trông 2 bảng thì sao?

nghĩa là bạn muốn xóa không trùng dữ liệu của cả sheet1?

Sub XoaKhongTrung()
  Dim Rng As Range
  Application.ScreenUpdating = False
  Sheet2.Cells.ClearContents
  For Each Rng In Sheet1.[B4].CurrentRegion
    If Rng = Sheet1.Cells(4, Rng.Column) Then
      Sheet2.Cells(Rng.Row, Rng.Column) = Rng
    Else
      Rng.ClearContents
    End If
  Next
  Set Rng = Nothing
  Application.ScreenUpdating = True
End Sub

lưu ý sub nầy chạy khá chậm

 

[hcl_pt]

bạn chạy code nầy xem sao, chắc chắn chậm hơn code của bạn SA_DQ, nếu chạy được mới có thể đoán được lý do bạn hỏi

Sub XoaKhongTrung()
  Dim Rng As Range
  Sheet2.Cells.ClearContents
  For Each Rng In Sheet1.[B4].CurrentRegion
    If Rng = Sheet1.Cells(4, Rng.Column) Then Sheet2.Cells(Rng.Row, Rng.Column) = Rng
  Next
  Set Rng = Nothing
End Sub

Cảm ơn bạn. Code này của bạn lại chạy tốt ạ!

 

[HieuCD]

Cảm ơn bạn. Code này của bạn lại chạy tốt ạ!

GPE có thể giải thích hộ mình sao code này mình chỉ chạy được với dữ liệu số cột tối đa là 173 cột? Xin cảm ơn!

có khả năng số dòng của bạn lớn và bộ nhớ không đủ nên mảng có kích thước lớn bị lổi

 

[ducmxd]

Mình muốn hỏi nếu mình chọn 2 dòng (dòng 4 và dòng 5) để so sánh với các dòng còn lại thì sao? dòng code này chỉ chọn 1 dòng 4 thôi (If Rng = Sheet1.Cells(4, Rng.Column) Then)

nghĩa là bạn muốn xóa không trùng dữ liệu của cả sheet1?

Sub XoaKhongTrung()
  Dim Rng As Range
  Application.ScreenUpdating = False
  Sheet2.Cells.ClearContents
  For Each Rng In Sheet1.[B4].CurrentRegion
    If Rng = Sheet1.Cells(4, Rng.Column) Then
      Sheet2.Cells(Rng.Row, Rng.Column) = Rng
    Else
      Rng.ClearContents
    End If
  Next
  Set Rng = Nothing
  Application.ScreenUpdating = True
End Sub

lưu ý sub nầy chạy khá chậm

 

[HieuCD]

Mình muốn hỏi nếu mình chọn 2 dòng (dòng 4 và dòng 5) để so sánh với các dòng còn lại thì sao? dòng code này chỉ chọn 1 dòng 4 thôi (If Rng = Sheet1.Cells(4, Rng.Column) Then)

bạn dùng từ khóa OR để kết nối 2 điều kiện

Sub XoaKhongTrung()
  Dim Rng As Range
  Application.ScreenUpdating = False
  Sheet2.Cells.ClearContents
  For Each Rng In Sheet1.[B4].CurrentRegion
    If Rng = Sheet1.Cells(4, Rng.Column) Or Rng = Sheet1.Cells(5, Rng.Column) Then
      Sheet2.Cells(Rng.Row, Rng.Column) = Rng
    Else
      Rng.ClearContents
    End If
  Next
  Set Rng = Nothing
  Application.ScreenUpdating = True
End Sub

 

[ducmxd]

Ok. Thanks bạn code chạy rất hay

bạn dùng từ khóa OR để kết nối 2 điều kiện

Sub XoaKhongTrung()
  Dim Rng As Range
  Application.ScreenUpdating = False
  Sheet2.Cells.ClearContents
  For Each Rng In Sheet1.[B4].CurrentRegion
    If Rng = Sheet1.Cells(4, Rng.Column) Or Rng = Sheet1.Cells(5, Rng.Column) Then
      Sheet2.Cells(Rng.Row, Rng.Column) = Rng
    Else
      Rng.ClearContents
    End If
  Next
  Set Rng = Nothing
  Application.ScreenUpdating = True
End Sub