Code lọc tên hàng xuất từ 2 lần trở lên

hondacrv2019 · 20/5/19

Chào cả nhà
Em cần giúp đoạn code tên hàng xuất hiện từ 2 lần trở lên không phân biệt chữ Hoa chự thường
Ảnh bên dưới Tên hàng A ,B,C xuất hiện 2 lần trở lên nên xuất kết qua ra cột B1

Dữ liệu hiện tại của File là 5000 dòng. Xin cảm ơn GPE

ongke0711 · 20/5/19

Đây là code dùng ADO recordset và chạy câu lệnh truy vấn:
s = "SELECT F1 FROM " & sRngName & " GROUP BY F1 HAVING Count(F1)>1"

Bạn copy code bên dưới vào module.
- Đổi tên "Sheet1" thành Sheet tương ứng trong file của bạn.
- Bạn tạo Name range cho cột dữ liệu cần tổng hợp và đặt tên là "Data".
- Chạy Sub TongHop trong cửa sổ Immediate

Mã:

Sub TongHop()
    Dim oCnn As Object
    Dim oRst As Object
    Dim sRngName As String, fileExcel As String
    Dim s As String

    Const adOpenStatic = 3
    Const adLockOptimistic = 3
    Const adCmdText = &H1

    Set oCnn = CreateObject("ADODB.Connection")
    Set oRst = CreateObject("ADODB.Recordset")

    fileExcel = ThisWorkbook.FullName
    With oCnn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & fileExcel & ";" & _
                            "Extended Properties=""Excel 12.0 Xml;HDR=No;"";"
        .Open
    End With

    sRngName = "Data"
    s = "SELECT F1 FROM " & sRngName & " GROUP BY F1 " & _
        "HAVING Count(F1)>1"

    oRst.CursorLocation = 3    'adUseClient
    oRst.Open s, oCnn, adOpenStatic, adLockOptimistic, adCmdText
    Sheet1.Range("B1:B" & Sheet1.Range("B" & Rows.Count).End(xlUp).Row).ClearContents
    Sheet1.Range("B1").CopyFromRecordset oRst


    oRst.Close
    Set oRst = Nothing
    If Not oCnn Is Nothing Then
        oCnn.Close
        Set oCnn = Nothing
    End If

End Sub

(PS: bạn đặt nickname cũng đặc biệt quá)

hondacrv2019 · 20/5/19

ongke0711 đã viết:
Đây là code dùng ADO recordset và chạy câu lệnh truy vấn:
s = "SELECT F1 FROM " & sRngName & " GROUP BY F1 HAVING Count(F1)>1"

Bạn copy code bên dưới vào module.
- Đổi tên "Sheet1" thành Sheet tương ứng trong file của bạn.
- Bạn tạo Name range cho cột dữ liệu cần tổng hợp và đặt tên là "Data".
- Chạy Sub TongHop trong cửa sổ Immediate

Mã:

Sub TongHop() Dim oCnn As Object Dim oRst As Object Dim sRngName As String, fileExcel As String Dim s As String Const adOpenStatic = 3 Const adLockOptimistic = 3 Const adCmdText = &H1 Set oCnn = CreateObject("ADODB.Connection") Set oRst = CreateObject("ADODB.Recordset") fileExcel = ThisWorkbook.FullName With oCnn .Provider = "Microsoft.ACE.OLEDB.12.0" .ConnectionString = "Data Source=" & fileExcel & ";" & _ "Extended Properties=""Excel 12.0 Xml;HDR=No;"";" .Open End With sRngName = "Data" s = "SELECT F1 FROM " & sRngName & " GROUP BY F1 " & _ "HAVING Count(F1)>1" oRst.CursorLocation = 3 'adUseClient oRst.Open s, oCnn, adOpenStatic, adLockOptimistic, adCmdText Sheet1.Range("B1:B" & Sheet1.Range("B" & Rows.Count).End(xlUp).Row).ClearContents Sheet1.Range("B1").CopyFromRecordset oRst oRst.Close Set oRst = Nothing If Not oCnn Is Nothing Then oCnn.Close Set oCnn = Nothing End If End Sub

cảm ơn anh nhiều. anh có thể nào viết code mãng đơn giản thôi. tại dữ liệu em ước lượng 5000 dòng thôi. Hiện tại chỉ có 200 tên thôi anh. Nhìn code rối và dài quá. mong anh giúp em

ongke0711 · 20/5/19

chutichhochiminh đã viết:
cảm ơn anh nhiều. anh có thể nào viết code mãng đơn giản thôi. tại dữ liệu em ước lượng 5000 dòng thôi. Hiện tại chỉ có 200 tên thôi anh. Nhìn code rối và dài quá. mong anh giúp em

Haha...vụ code mảng thì tôi potay nhé.
Nhờ các bạn khác hỗ trợ giùm thôi.
(PS: Code chỉ dài chứ không rối đối với ADO nhé )

befaint · 20/5/19

ongke0711 đã viết:
vụ code mảng thì tôi potay nhé.

Lý thuyết mảng trong VBA cũng không dài, anh thử đọc thêm xem..

snow25 · 20/5/19

befaint đã viết:
Lý thuyết mảng trong VBA cũng không dài, anh thử đọc thêm xem..

Em thấy mảng dùng rễ hơn ADO nhiều.

Phuocam · 20/5/19

Dùng AdvancedFilter hoặc code

Mã:

Sub Test()
Dim lastRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("A1:A" & lastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("B1:B2"), CopyToRange:=Range("D1"), Unique:=True
End Sub

CHAOQUAY · 20/5/19

Mã:

Sub Xuat_2TroLen()
Dim Nguon, Mang, i
Nguon = Sheet1.Range("A1:A8")
ReDim Mang(UBound(Nguon))
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Nguon)
    .Item(Nguon(i, 1)) = .Item(Nguon(i, 1)) + 1
    If .Item(Nguon(i, 1)) = 2 Then
        .Item(2) = .Item(2) + 1
        Mang(.Item(2) - 1) = Nguon(i, 1)
    End If
Next i
Sheet1.Range("B1").Resize(.Item(2), 1) = WorksheetFunction.Transpose(Mang)
End With
End Sub

hondacrv2019 · 20/5/19

phuocam đã viết:
Dùng AdvancedFilter hoặc code

Mã:

Sub Test() Dim lastRow As Long lastRow = Range("A" & Rows.Count).End(xlUp).Row Range("A1:A" & lastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("B1:B2"), CopyToRange:=Range("D1"), Unique:=True End Sub

cảm ơn bạn. Thật code dùng AdvancedFilter mình cũng biết , nó có bất tiện là Chậm và có 1 vùng cột phụ. Em đang code mãng này mà không biết sửa điều kiện làm sao để >1

Mã:

Sub LOCcoban()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Col As Long
sArr = Range("a1:a1000").Value ' DU LIEU DAU VAO
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 1) ' 3 COT
For I = 1 To R
    If Dem trong mang > 1 Then ' DKIEN lam sao hieu de > 1
        K = K + 1
        For Col = 1 To 1 ' 3 COT
            dArr(K, Col) = sArr(I, Col)
        Next Col
    End If
Next I
' OUTPUT
On Error Resume Next
Range("b1").Resize(R, 1).ClearContents
Range("b1").Resize(K, 1) = dArr ' 3 COT
End Sub

If Dem trong mang > 1 Then ' Điều kiện làm sao để đếm > 1

befaint · 20/5/19

chutichhochiminh đã viết:
mãng này

MẢNG chứ không phải "MÃNG".

chutichhochiminh đã viết:
điều kiện làm sao để >1

Cách thì có vài cách..
- Mượn hàm Countif() của worksheetFunction
- Dùng hàm Filter (mảng một chiều) của VBA.
- Dùng các công cụ cho phép nạp các đối tượng của mảng vào thư viện để xét sự tồn tại.. (ví dụ #8)
...

CHAOQUAY · 20/5/19

chutichhochiminh đã viết:
cảm ơn bạn. Thật code dùng AdvancedFilter mình cũng biết , nó có bất tiện là Chậm và có 1 vùng cột phụ. Em đang code mãng này mà không biết sửa điều kiện làm sao để >1
....
If Dem trong mang > 1 Then ' Điều kiện làm sao để đếm > 1

Có lẽ là ít nhất có 2 cách :
Quét tuần tự, nối tên thành chuỗi, dùng instr để kiểm tra
Chuyển nguồn về mảng 1 chiều & dùng filter

hondacrv2019 · 20/5/19

befaint đã viết:
MẢNG chứ không phải "MÃNG".

Cách thì có vài cách..
- Mượn hàm Countif() của worksheetFunction
- Dùng hàm Filter (mảng một chiều) của VBA.
- Dùng các công cụ cho phép nạp các đối tượng của mảng vào thư viện để xét sự tồn tại.. (ví dụ #8)
...

dạ em cảm ơn bác. tại em gõ nhầm. Tại mới tập tành VBA nên bác thông cảm giúp em. Tại em chỉ đang mày mò và range chưa xong, giờ sang mảng chắc em chết

befaint · 20/5/19

chutichhochiminh đã viết:
dạ em cảm ơn bác. tại em gõ nhầm. Tại mới tập tành VBA nên bác thông cảm giúp em. Tại em chỉ đang mày mò và range chưa xong, giờ sang mảng chắc em chết

Thì dùng cái đơn giản là hàm countif() đó.

hondacrv2019 · 20/5/19

befaint đã viết:
Thì dùng cái đơn giản là hàm countif() đó.

Cuuntif nó chí đếm tên nào xuất hiện >1 lần mà nó không có xuất ra 1 vùng bác à. Em cần xuất ra 1 vùng để cho dễ quán lý

VetMini · 20/5/19

chutichhochiminh đã viết:
cảm ơn anh nhiều. anh có thể nào viết code mãng đơn giản thôi. tại dữ liệu em ước lượng 5000 dòng thôi. Hiện tại chỉ có 200 tên thôi anh. Nhìn code rối và dài quá. mong anh giúp em

Lý do tại sao mảng thì đơn giản?
Mảng trong VBA chỉ là một dãy dữ liệu liên tiếp, có thể dùng chỉ số để truy cập tửng mảnh dữ liệu cá thể.
Đề bài của bạn cần lọc. Không có cách nào đơn giản với mảng cả.
Muốn làm với mảng thì bắt buộc phải sắp xếp mảng và duyệt.
Chỉ có những loại cấu trúc dữ liệu phức tạp hơn mới có những hàm và thuộc tính giúp bạn trong trường hợp này.

Bài này chủ yếu là lọc dữ liệu cho nên có hai giải thuật dễ nhất:
1. lợi dụng tính chất lọc của SQL để lọc dữ liệu. Và đối tượng ADODB giúp ta thực hiện.
2. lợi dụng tính chất key-value của Dictionary để lọc dữ liệu (đếm số lần xuất hiện của mỗi trị)

Điều 1 được diễn tả qua code ở bài #2 và điều 2 code ở bài #8

Code ADO trông rắc rối là vì nó làm một số thủ tục mà thực sự không thuộc về giải thuật của bài. Cũng giống như bạn lên xe thì phải mở khóa, bấm đề pa cho máy nỏ, sang số... các thủ tục không thuộc về con đường bạn cần đi từ A đến B.
Muốn giản gọn, bạn có thể nhờ tác giả lôi ba cái mớ kết nối và đọc recordset vào 1 hàm. Hàm này trả về một mảng dữ liệu. Khi ấy bạn có quyền làm ngơ với mọi rắc rối. Code của bạn chỉ gọi hàm và lấy kết quả. Đổ vào đâu tùy ý.

Code bài #8 trông cũng rắc rối là vì tác giả theo tôn chỉ "tiết kiệm số vòng lặp" của diễn đàn này (*).
Cách thực hiện đơn giản hơn là dùng 2 vòng lặp. Vòng thứ nhất đếm số lần xuất hiện của mỗi danh mục. Vòng thứ hai duyệt lại dictionary và remove những danh mục xuất hiện ít hơn nhu cầu.

(*) Diễn đàn này có nhiều sì tin viết code không theo lý thuyết căn bản lập trình. Nhưng cũng chả sao. Từ A trong VBA là "application" (ứng dụng). Người viết code có quyền bỏ qua lý thuyết căn bản.
Chỉ tiếc là họ đã xem thường một điều không phải lý thuyết: họ đã tập thói quen viết code không có chú thích.

SA_DQ · 21/5/19

Em cần giúp đoạn code tên hàng xuất hiện từ 2 lần trở lên không phân biệt chữ Hoa chự thường
Ảnh bên dưới Tên hàng A ,B,C xuất hiện 2 lần trở lên nên xuất kết qua ra cột B1
Dữ liệu hiện tại của File là 5000 dòng. Xin cảm ơn GPE

Nếu bạn xài E2007 trở lên & có kiến thức vế phương thức FIND() thì cò thể giải quyết vấn đề của bạn qua các bước sau:
Bước chuẩn bị: Khai báo các biến để dùng
B1: Cột dữ liệu ta đưa vô biến vùng (Range)
B1.1 Lập danh sách duy nhất (DS) từ cột dữ liệu vừa nêu
B2 Tạo vòng lặp tìm (FIND()) lần lượt theo DS xem "em' nào có trong cột dữ liệu & có là bao nhiêu
B2.1 Ghi vô mảng những 'em' có nhiều lần được tìm thấy
B3: Cho hiện kết quả mảng lên cột 'B'

Nói trước: Đây là cách rùa bò nhất & có thể ghi vô quyễn kỉ lục họ 'G", nhưng với dưới vạn dòng thì tàm tạm

Chúc vui nha!

snow25 · 21/5/19

chutichhochiminh đã viết:
Cuuntif nó chí đếm tên nào xuất hiện >1 lần mà nó không có xuất ra 1 vùng bác à. Em cần xuất ra 1 vùng để cho dễ quán lý

Vậy bạn nghiên cứu Dictionary.

ongke0711 · 21/5/19

VetMini đã viết:
Code ADO trông rắc rối là vì nó làm một số thủ tục mà thực sự không thuộc về giải thuật của bài. Cũng giống như bạn lên xe thì phải mở khóa, bấm đề pa cho máy nỏ, sang số... các thủ tục không thuộc về con đường bạn cần đi từ A đến B.
Muốn giản gọn, bạn có thể nhờ tác giả lôi ba cái mớ kết nối và đọc recordset vào 1 hàm. Hàm này trả về một mảng dữ liệu. Khi ấy bạn có quyền làm ngơ với mọi rắc rối. Code của bạn chỉ gọi hàm và lấy kết quả. Đổ vào đâu tùy ý.

Rút kinh nghiệm vụ đưa vô hàm để nhìn đỡ rối. Lúc trước em có viết cái class dùng kết nối (và chạy các stored proc.) 3 loại CSDL: Access, SQL Server và Excel. Những lần sau có dùng ADODB sẽ dùng nó khai báo kết nối để nhìn code nó gọn gàng.

VetMini · 21/5/19

' Hàm giản dị để lấy dữ liệu qua ADO
' Hàm viết theo chính sách giản dị, chỉ ứng dụng cho 1 số trường hợp tổng quát. Không phù hợp với những người thích viết một hàm bao gồm 99% trường hợp
' Lưu ý là hàm trả về 1 mảng cho nên chỉ áp dụng với dữ liệu vài cột, vài ngàn dòng
' nếu nhiều hơn nữa thì dùng hàm khác, trả về cả recordset
Function LayDuLieuBangADO(sqlStr As String, fPath As String) As Variant
' (mở kết nối, dùng sqlSttr lấy recordset ở đây)
LayDuLieuBangADO = rSet.GetRows()
End Function

Code gọi hàm trên để lấy dữ liệu:
a = LayDuLieuBangADO("Select * From ....", thisFilePath)
Range(ô đầu tiên).Resize(UBound(a)-LBound(a)+1,1) = a

Code dictionary giản dị:
With CreateObject("Scripting.Dictionary")
For Each c In Range(cell đầu đến cell cuối)
If Not IsEmpty(c) Then .Item(c.Value) = .Item(c.Value) + 1 ' đếm số lần xuất hiện của mỗi trị
Next c
For Each c in .Keys()
If .Item(c) < 2 Then .Remove c ' loại các trị xuất hiện dưới 2 lần
Next c
Range(ô đầu tiên).Resize(.Count) = Application.Transpose(.Keys())
End With

ongke0711 · 23/5/19

VetMini đã viết:
With CreateObject("Scripting.Dictionary")
...
End With

Anh Vietmini cho hỏi chút về dòng khai báo này. Theo cách trên thì VBA tự tạo ngầm một biến đối tượng với tên gì đó rồi nó có tự giải phóng biến này không anh?

Code lọc tên hàng xuất từ 2 lần trở lên

Thành viên bị đình chỉ hoạt động

Thành viên gắn bó

Thành viên bị đình chỉ hoạt động

Thành viên gắn bó

|||||||||||||

Thành viên gạo cội

Thành viên mới

File đính kèm

Thành viên gắn bó

Thành viên bị đình chỉ hoạt động

|||||||||||||

Thành viên gắn bó

Thành viên bị đình chỉ hoạt động

|||||||||||||

Thành viên bị đình chỉ hoạt động

Ăn cùng góc phố

/(hông là gì!

Thành viên gạo cội

Thành viên gắn bó

Ăn cùng góc phố

Thành viên gắn bó

Đếm ngược thời gian