Tìm các cty có tên trùng nhau

trithanhkt2 · 30/1/13

Các bác giúp em cái này, tìm các công ty có tên trung nhau và đánh dấu lại,
có những trường hợp như sau:
Công ty ABC
Cty ABC
DNTN XYZLMN
DN tư nhân XYZLMN
Doanh nghiệp tư nhân XYZLMN
em có gửi file kèm theo nhờ các bác nào rành giúp em. ^^

hungpecc1 · 30/1/13

trithanhkt2 đã viết:
Các bác giúp em cái này, tìm các công ty có tên trung nhau và đánh dấu lại,
có những trường hợp như sau:
Công ty ABC
Cty ABC
DNTN XYZLMN
DN tư nhân XYZLMN
Doanh nghiệp tư nhân XYZLMN
em có gửi file kèm theo nhờ các bác nào rành giúp em. ^^

cái này có khi phải dùng đến vba bạn ah

trithanhkt2 · 30/1/13

bác có thể hướng dẫn chi tiết giúp em được ko ạ

hungpecc1 · 30/1/13

Thử code "cùi cùi" này xem :
( các cty trùng nhau , sẽ đc tô màu vàng tại cột C)

Mã:

Sub filter()
    Dim tmparr, item, arr
    Dim n As Long, i As Long, ir As Long
        ActiveSheet.AutoFilterMode = flase
        tmparr = Range("B1", Range("B65536").End(3))
        With CreateObject("Scripting.Dictionary")
            For Each item In tmparr
                ir = ir + 1
                If Len(item) Then
                    item = Replace(item, "DNTN", "", , , vbTextCompare)
                    item = Replace(item, "Công ty", "", , , vbTextCompare)
                    item = Replace(item, "DN T? Nhân", "", , , vbTextCompare)
                    item = Replace(item, "Cty", "", , , vbTextCompare)
                    tmp = Trim(CStr(item))
                    If Not .Exists(tmp) Then
                        n = n + 1
                        .Add tmp, n
                    Else
                         Range("C:C").Cells(ir).Interior.Color = 65535
                    End If
                End If
            Next
        End With
End Sub

File đính kèm

trithanhkt2 · 30/1/13

Tks bác nhé, vậy em muốn thêm VD cửa tiệm, cửa hàng thì em thêm vào y chang item = Replace(item, "****", "", , , vbTextCompare) cái chỗ **** phải ko

vutienhp · 30/1/13

hungpecc1 đã viết:

Thử code "cùi cùi" này xem :
( các cty trùng nhau , sẽ đc tô màu vàng tại cột C)

Mã:

Sub filter()
    Dim tmparr, item, arr
    Dim n As Long, i As Long, ir As Long
        ActiveSheet.AutoFilterMode = flase
        tmparr = Range("B1", Range("B65536").End(3))
        With CreateObject("Scripting.Dictionary")
            For Each item In tmparr
                ir = ir + 1
                If Len(item) Then
                    item = Replace(item, "DNTN", "", , , vbTextCompare)
                    item = Replace(item, "Công ty", "", , , vbTextCompare)
                    item = Replace(item, "DN T? Nhân", "", , , vbTextCompare)
                    item = Replace(item, "Cty", "", , , vbTextCompare)
                    tmp = Trim(CStr(item))
                    If Not .Exists(tmp) Then
                        n = n + 1
                        .Add tmp, n
                    Else
                         Range("C:C").Cells(ir).Interior.Color = 65535
                    End If
                End If
            Next
        End With
End Sub

File đính kèm

Bạn cho mình hỏi, có thể viết code để các cặp Cty trùng nhau sẽ có màu sắc khác nhau được không, để dễ nhận ra sự khác biệt.
Xin cảm ơn!

trithanhkt2 · 30/1/13

Bác ơi, trường hợp này không tìm ra, VD:
+ Ghi nhầm DNTN với Công ty
DNTN Kim Ngân
Công ty TNHH Kim Ngân
Bác hungpecc1 giúp em tí nhé ^^ tks bác nhiều

hungpecc1 · 30/1/13

vutienhp đã viết:
Bạn cho mình hỏi, có thể viết code để các cặp Cty trùng nhau sẽ có màu sắc khác nhau được không, để dễ nhận ra sự khác biệt.
Xin cảm ơn!

Bạn thử thay dòng code .Interior.Color = int(rnd()*1000) xem

hungpecc1 · 30/1/13

trithanhkt2 đã viết:
Bác ơi, trường hợp này không tìm ra, VD:
+ Ghi nhầm DNTN với Công ty
DNTN Kim Ngân
Công ty TNHH Kim Ngân
Bác hungpecc1 giúp em tí nhé ^^ tks bác nhiều

Hix sao dữ liệu bạn ban đầu bạn vào có nhiều sai lệch thế :

bạn liệt kế hết trường hợp được không

còn nếu chỉ có cái DNTN = công ty TNHH thì bạn thêm dòng này vào nữa thử xem

item = Replace(item, "công ty TNHH ", "", , , vbTextCompare)

trithanhkt2 · 30/1/13

sao nó chỉ đánh dấu có 1 tên, không đánh dấu được 2 tên trùng nhau vậy bạn

trithanhkt2 · 30/1/13

để mình liệt kê nha bạn mình gửi file qua nhé

hungpecc1 · 30/1/13

trithanhkt2 đã viết:
để mình liệt kê nha bạn mình gửi file qua nhé

Thử thay bằng code này xem sao :

Mã:

Sub filter()
    Dim tmparr, item
    Dim n As Long, i As Long, ir As Long
        ActiveSheet.AutoFilterMode = flase
        tmparr = Range("B1", Range("B65536").End(3))
        With CreateObject("Scripting.Dictionary")
            For Each item In tmparr
                ir = ir + 1
                If Len(item) Then
                    item = Replace(item, "DNTN", "", , , vbTextCompare)
                    item = Replace(item, "Công ty", "", , , vbTextCompare)
                    item = Replace(item, "DN T? Nhân", "", , , vbTextCompare)
                    item = Replace(item, "Cty", "", , , vbTextCompare)
                    item = Replace(item, "công ty TNHH ", "", , , vbTextCompare)
                    tmp = Trim(CStr(item))
                    If Not .Exists(tmp) Then
                        .Add tmp, ir
                    Else
                         Range("C:C").Cells(ir).Interior.Color = .item(tmp) * 100
                         Range("C:C").Cells(.item(tmp)).Interior.Color = .item(tmp) * 100
                    End If
                End If
            Next
        End With
End Sub

vutienhp · 30/1/13

hungpecc1 đã viết:
Bạn thử thay dòng code .Interior.Color = int(rnd()*1000) xem

Ý của mình:
Ví dụ có nhiều Cty TNHH A trùng nhau thì cho 1 màu xanh( chẳng hạn)

có nhiều Cty TNHH B trùng nhau thì cho 1 màu hồng....
Tóm lại là cùng 1 màu cho nhiều Cty trùng nhau, nhưng Cty khác nhau có màu khác nhau
Bạn xem giúp!

trithanhkt2 · 30/1/13

Có trường hợp ghi nhầm:
DNTN ABC
Công ty TNHH ABC
Công ty cổ phần ABC
vẫn ko tìm ra được
mình thử chèn code nhưng vẫn không được

item = Replace(item, "công ty TNHH ", "", , , vbTextCompare)
item - Replace(item, "công ty cổ phần ", "", , , VbTextCompare)

trithanhkt2 · 30/1/13

Bác giúp em xem cái excel ở page 11 nhe, tks mấy bác

hungpecc1 · 30/1/13

trithanhkt2 đã viết:
Bác giúp em xem cái excel ở page 11 nhe, tks mấy bác

Xem thử file này rồi tùy biến thêm bạn nhé

trithanhkt2 · 30/1/13

CHuẩn quá rồi bác ạ, e sẽ tùy biến thêm , tks bác nhiều nhé ^^!

trithanhkt2 · 30/1/13

Trường hợp này thì ko tìm ra bác ơi...phiền các bác quá hic...
Công ty Vạn Lợi Chế biến mủ Cao su
Công ty TNHH Vạn Lợi
Chắc hum nào phải mời bác đi ún cf quá hic hic

Tìm các cty có tên trùng nhau

Thành viên mới

File đính kèm

Thành viên gắn bó

Thành viên mới

Thành viên gắn bó

Thành viên mới

Thành viên hoạt động

Thành viên mới

Thành viên gắn bó

Thành viên gắn bó

Thành viên mới

Thành viên mới

File đính kèm

Thành viên gắn bó

Thành viên hoạt động

Thành viên mới

Thành viên mới

Thành viên gắn bó

Thành viên mới

Thành viên mới

Đếm ngược thời gian