


Làm bằng code VBA có được "hông"?Nhờ các anh chị pro giúp em lọc các số trong các cell với ạ. Số nào đã trùng thì chỉ lấy 1 lần, không lấy số bị trùng nữa ạ! Em có gửi file đính kèm, mong anh chị chỉ giúp em ạ! Em xin cảm ơn!
Làm bằng code VBA có được "hông"?
Function JoinUnique(Rng As Range)
JoinUnique = " " & Application.Trim(Replace(Join(Application.Transpose(Rng.Value)), ",", " "))
i = 1
Do
j = InStr(i + 1, JoinUnique, " ")
If j = 0 Then Exit Do
JoinUnique = Left(JoinUnique, j - 1) & Replace(JoinUnique, Mid(JoinUnique, i, j - i), "", j)
i = j
Loop
JoinUnique = Trim(JoinUnique)
With CreateObject("MSScriptControl.ScriptControl")
.Language = "JavaScript"
JoinUnique = .Eval("('" & JoinUnique & "').split(' ').sort(function(a,b){return (a-b)}).join(', ')")
End With
End Function
Công thức thì thua, bạn dùng Macro tạm vậy.
Kết quả mẫu thiếu 4 và 15.
PHP:Function JoinUnique(Rng As Range) JoinUnique = " " & Application.Trim(Replace(Join(Application.Transpose(Rng.Value)), ",", " ")) i = 1 Do j = InStr(i + 1, JoinUnique, " ") If j = 0 Then Exit Do JoinUnique = Left(JoinUnique, j - 1) & Replace(JoinUnique, Mid(JoinUnique, i, j - i), "", j) i = j Loop JoinUnique = Trim(JoinUnique) With CreateObject("MSScriptControl.ScriptControl") .Language = "JavaScript" JoinUnique = .Eval("('" & JoinUnique & "').split(' ').sort(function(a,b){return (a-b)}).join(', ')") End With End Function
Hi, em cảm ơn a ạ! E dùng hok có bị lỗi gì cả, có điều làm một số khác thì thiếu số 1. E có gửi đính kèm file ạ!Công thức thì thua, bạn dùng Macro tạm vậy.
Kết quả mẫu thiếu 4 và 15.
PHP:Function JoinUnique(Rng As Range) JoinUnique = " " & Application.Trim(Replace(Join(Application.Transpose(Rng.Value)), ",", " ")) i = 1 Do j = InStr(i + 1, JoinUnique, " ") If j = 0 Then Exit Do JoinUnique = Left(JoinUnique, j - 1) & Replace(JoinUnique, Mid(JoinUnique, i, j - i), "", j) i = j Loop JoinUnique = Trim(JoinUnique) With CreateObject("MSScriptControl.ScriptControl") .Language = "JavaScript" JoinUnique = .Eval("('" & JoinUnique & "').split(' ').sort(function(a,b){return (a-b)}).join(', ')") End With End Function
Lúc viết tôi chưa lường trước trường hợp này. Bạn thử lại code này nhé:Hi, em cảm ơn a ạ! E dùng hok có bị lỗi gì cả, có điều làm một số khác thì thiếu số 1. E có gửi đính kèm file ạ!
Function JoinUnique(Rng As Range)
JoinUnique = " " & Application.Trim(Replace(Join(Application.Transpose(Rng.Value)), ",", " ")) & " "
i = 1
Do
j = InStr(i + 1, JoinUnique, " ")
If j = 0 Then Exit Do
JoinUnique = Left(JoinUnique, j - 1) & Replace(JoinUnique, Mid(JoinUnique, i, j - i + 1), " ", j)
i = j
Loop
JoinUnique = Trim(JoinUnique)
With CreateObject("MSScriptControl.ScriptControl")
.Language = "JavaScript"
JoinUnique = .Eval("('" & JoinUnique & "').split(' ').sort(function(a,b){return (a-b)}).join(', ')")
End With
End Function
Tôi thấy trên GPE có vài bài hỏi vấn đề này, bạn tìm mấy bài đó xem thử sao. Tôi không gặp lỗi này nên cũng không xem.anh ơi sao code chạy bị lỗi gì nè
![]()
![]()
Hay quá a! E nể phục a quá! E muốn tự học cách viết code, mong a gợi ý các tài liệu nào hay giới thiệu e với ạ! E cảm ơn a nhiều!Lúc viết tôi chưa lường trước trường hợp này. Bạn thử lại code này nhé:
PHP:Function JoinUnique(Rng As Range) JoinUnique = " " & Application.Trim(Replace(Join(Application.Transpose(Rng.Value)), ",", " ")) & " " i = 1 Do j = InStr(i + 1, JoinUnique, " ") If j = 0 Then Exit Do JoinUnique = Left(JoinUnique, j - 1) & Replace(JoinUnique, Mid(JoinUnique, i, j - i + 1), " ", j) i = j Loop JoinUnique = Trim(JoinUnique) With CreateObject("MSScriptControl.ScriptControl") .Language = "JavaScript" JoinUnique = .Eval("('" & JoinUnique & "').split(' ').sort(function(a,b){return (a-b)}).join(', ')") End With End Function
Tôi thấy trên GPE có vài bài hỏi vấn đề này, bạn tìm mấy bài đó xem thử sao. Tôi không gặp lỗi này nên cũng không xem.
Public Function Loc(nguon As Range)
Dim c As Long, Tam
Tam = " " & Replace(Join(Application.Transpose(nguon)), ",", " ") & " "
Do While Len(Replace(Tam, " ", "")) > 0
If InStr(Tam, " " & c & " ") Then
Loc = Loc & " " & c
Tam = Replace(Tam, " " & c & " ", " ")
End If
c = c + 1
Loop
Loc = Replace(Trim(Loc), " ", ", ")
End Function
---Mã:Public Function Loc(nguon As Range) Dim c As Long, Tam Tam = " " & Replace(Join(Application.Transpose(nguon)), ",", " ") & " " Do While Len(Replace(Tam, " ", "")) > 0 If InStr(Tam, " " & c & " ") Then Loc = Loc & " " & c Tam = Replace(Tam, " " & c & " ", " ") End If c = c + 1 Loop Loc = Replace(Trim(Loc), " ", ", ") End Function
Dữ liệu theo cột và > 1 ô
Thì cũng tùy bệnh bốc thuốc, đau đâu chữa đấy.Nếu dữ liệu có số hàng triệu (số hóa đơn có 7 chữ số) chắc chạy mệt mỏi.
Công thức thì thua, bạn dùng Macro tạm vậy.
Kết quả mẫu thiếu 4 và 15.
PHP:Function JoinUnique(Rng As Range) JoinUnique = " " & Application.Trim(Replace(Join(Application.Transpose(Rng.Value)), ",", " ")) i = 1 Do j = InStr(i + 1, JoinUnique, " ") If j = 0 Then Exit Do JoinUnique = Left(JoinUnique, j - 1) & Replace(JoinUnique, Mid(JoinUnique, i, j - i), "", j) i = j Loop JoinUnique = Trim(JoinUnique) With CreateObject("MSScriptControl.ScriptControl") .Language = "JavaScript" JoinUnique = .Eval("('" & JoinUnique & "').split(' ').sort(function(a,b){return (a-b)}).join(', ')") End With End Function
Đã bị khiếu nại và đã sửa lại ở bài #7 rồi anh à.Code này sai. Nếu ta có range [A1:A10] = { 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 } thì kết quả là "1, 2, 3, 4, 5, 6, 7, 8, 90"
Code sai ở vòng lặp lọc trị duy nhất. Vì phép so sánh khong có ký tự phân chuỗi cho nên 1 bị nhân lầm vào một phần của 10.
Chú thích: Phần createobject... chỉ là một cách lợi dụng khả năng sort của JavaScript để sắp xếp lại, không đáng kể. Tuy rằng máy không enable ScriptHost có khả năng bị kẹt - chỉ "có khả năng", còn tuỳ thuộc vài yếu tố khác.
Đã bị khiếu nại và đã sửa lại ở bài #7 rồi anh à.