Hàm tự tạo đó bạn!
Bạn thử đưa 1 file gần giống với thực tế nhất lên đây (file có 300,000 dòng ấy)
Sub THop()
Dim Dic As Object, Cls As Range, tam1, tam2, i
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
i = 1
For Each Cls In .Range(.[D4], .[D65536].End(3))
If Not Dic.Exists(Cls.Value) Then
Dic.Add Cls.Value, Chuoi(Cls)
End If
Next
tam1 = Dic.keys
tam2 = Dic.items
For i = 0 To Dic.Count - 1
.Cells(i + 5, "H") = tam1(i) & " ( " & tam2(i) & " )"
Next
End With
Set Dic = Nothing : Set Cls = Nothing
End Sub
'===============================================
Function Chuoi(ByVal Ch As String) As String
Dim Rng As Range, Dc As String, tam As String
With Sheet1.Range("D4:D65536")
Set Rng = .Find(Ch, LookIn:=xlValues)
If Not Rng Is Nothing Then
Dc = Rng.Address
Do
If InStr(1, tam, Rng.Offset(, -1).Value) = 0 Then _
tam = IIf(Len(tam) > 0, tam & "-" & _
Rng.Offset(, -1).Value, Rng.Offset(, -1).Value)
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> Dc
End If
End With
Chuoi = tam
Set Rng = Nothing
End FunctionChèn 1 Module và paste code này vào:
Private Sub ConsolStr(ByVal sArr1, ByVal sArr2, ByVal Target As Range)
Dim tArr1, tArr2, Arr(1 To 1000000, 1 To 2), Tmp, Tmp1, Tmp2, Dic1, Dic2
Dim i As Long, j As Long, n As Long
tArr1 = sArr1: tArr2 = sArr2
Set Dic1 = CreateObject("Scripting.Dictionary")
Set Dic2 = CreateObject("Scripting.Dictionary")
For i = LBound(tArr1, 1) To UBound(tArr1, 1)
For j = LBound(tArr1, 2) To UBound(tArr1, 2)
If tArr1(i, j) <> "" Then
Tmp1 = tArr1(i, j): Tmp2 = tArr2(i, j)
Tmp = Tmp1 & Tmp2
If Not Dic1.Exists(Tmp) Then
Dic1.Add Tmp, ""
If Not Dic2.Exists(Tmp1) Then
n = n + 1
Dic2.Add Tmp1, n
Arr(n, 1) = Tmp1
Arr(n, 2) = Tmp2
Else
Arr(Dic2.Item(Tmp1), 2) = Arr(Dic2.Item(Tmp1), 2) & " - " & Tmp2
End If
End If
End If
Next j
Next i
Target.Resize(n, 2).Value = Arr
End SubSub Main()
Dim sArr1, sArr2, Target As Range, TG As Double
TG = Timer
sArr1 = Sheet1.Range("F2:F1000000").Value
sArr2 = Sheet1.Range("C2:C1000000").Value
Set Target = Sheet1.Range("L3")
Target.Resize(1000000, 2).Clear
ConsolStr sArr1, sArr2, Target
MsgBox Timer - TG
End Sub
. Khi thấy kết quả chạy ra (rất nhanh + chính xác) em thấy nó hơi dài ạ. Bác có thể chỉ giúp em :
Riêng về việc lấy 3 ký tự của Weekday thì rất dễBác NDU quá siêu
1/ Nếu được, bác dành chút thời gian comment từng dòng code cho em hiểu được kô ạ ? Em cũng muốn học hỏi chút ít ^^? Nhìn vô như đám rừng, em đọc chả hiểu j cả. Cám ơn bác lần nữa ạ.
2/ Xin lỗi bác do em ghi chú trong file kô kĩ
- tương ứng từng dòng chương trình (ví dụ "chao buoi sang") sẽ là 1 dòng kết quả tổng hợp (chao buoi sang (Mon-Sun))
- Ngày chiếu chỉ lấy 3 kí tự đầu. Ví dụ : Monday thành Mon, Sunday thành Sun
- Ngày chiếu liệt kê sẽ rất dài. Có cách nào tổng hợp lại cho gọn. Ví dụ: Mon-Sun là chiếu từ T2 tới CN. Mon-Thu,Sun là chiếu từ T2 tới T5 và CN (thứ 6,7 kô chiếu)
Chi tiết xem file đính kèm giúp em ạ.
@ Có dịp offline nhất định gặp bác NDU để thỉnh giáo
, Cách2 theo yêu cầu của bác
..
Cũng khó chứ chẳng phải dễ ăn đâu ---> Chỉ nội xem trong chuổi Mon-Tue-Wed-Sun, làm sao biến nó thành Mon--->Web,Sun cũng rã rời rồi (vì phải sort chuổi, xem đoạn này "liên tục" thì lấy thằng đầu và cuối)Nếu có thời gian bác làm giúp em 2 cách luôn được không bác ? Cách1 theo đúng yêu cầu của em
Học tại đây là ngon lành rồi!À, bác có dạy thêm lập trình VBA không ạ ? Em đăng kí học riêng với bác được không ? Học vào ngày cuối tuần (thứ 7 hay CN đều được). Em hâm mộ bác quá
Nếu được nhắn tin cho em số điện thoại + tên của bác nhé. Số em đây : 0989.023530 - em tên HIỂN.
LÀM GÌ MÀ HỌC CHEN NGANG NHƯ VẬY ĐƯỢC
. Chỉ là không siêu như mấy bác NDU mà thôi --> học trực tiếp là hay nhất.
Tôi nghĩ lại thấy diễn đàn này cũng có rất nhiều bạn có nhu cầu học VBA như bạn! Vậy sao không tập trung lại chừng 20 người rồi mở lớp?Em cũng có căn bản rồi bác. Khôgn phải là không biết gì
Năn nỉ quá trời mà bác NDU vẫn không chịu thì em đành tự mò thôi vậy
20"), 2, 0)
Đại ca ơi! Vấn đề ở đây không phải nằm ở chổ có viết code được hay không mà là: PHẢI VIẾT ĐỂ CODE CHẠY VỚI DỮ LIỆU LỚN VÀ TỐC ĐỘ NHANH
File gốc đây
