bun_bo_hue
Thành viên chính thức
- Tham gia
- 31/12/09
- Bài viết
- 78
- Được thích
- 11
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)Cám ơn bác nhiều lắm ạ. Hàm ra kết quả rất chính xác nhưng em vửa test thử hàm với 1000dòng, tốc độ hơi chậm 1 chút ^^ (nếu sử dụng cho data 300ngàn dòng thì chắc chậm nữa). Em kô có ý chê nhưng có cách nào làm cho nó nhanh lên kô pác ??? Hay đây là điểm yếu của các hàm tự tạo ?
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)
File lớn quá thì đưa lên mediafire nhé
----------------
Bài này chỉ có 1 "cửa" duy nhất có thể tăng tốc đó là: Dùng Array và Dictionary Object
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 Function
Chèn 1 Module và paste code này vào:Em load file gốc lên rồi. 2 bác tham khảo giúp em ạ. Quan trọng là ra KẾT QUẢ và NHANH. Cách j cũng đc ạ.
@ Bác ChanhTQ: Cám ơn bác rất nhiều ạ, tốc độ file rất nhanh. Nhưng có 1 vấn đề là nếu chương trình đó lập lại n lần (ví dụ có nhiều dòng "Chương trình A - Monday" xuất hiện không chỉ 1 lần) thì nó sẽ ra kết quả tổng hợp là "Chương Trình A (Mon,Mon,Mon,Mon,Tue,Wed)", Monday cũng lập lại nhiều lần. Có cách nào tổng hợp thành "Chương Trình A (Mon,Tue,Wed)" đc kô bác ?. File gốc bác down link bên dưới về giúp em ạ.
@ Bác NDU : em load file 200ngàn dòng. Bác tham khảo cách làm giúp.
Cám ơn 2 bác rất nhiều.
https://www.yousendit.com/download/RlRwM25FMVhFd2RFQlE9PQ
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 Sub
Sub 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
Chèn 1 Module và paste code này vào:
PHP: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 Sub
Thiết lập sẳn cho bạn 1 triệu dòng đấy ---> Thời gian chạy xong code là 3 giâyPHP:Sub 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
Hài lòng chứ!
--------------
Lưu ý: Để chạy được code trên Excel 2007 thì phải lưu nó với định dạng xlsm nha
Riêng về việc lấy 3 ký tự của Weekday thì rất dễBác NDU quá siêu , quá VIP, độ CHÍNH XÁC TUYỆT ĐỐI còn TỐC ĐỘ thì tuyệt vời, cám ơn bác nhiều lắm ạ.
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ĩ . 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 :
- 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
Riêng về việc lấy 3 ký tự của Weekday thì rất dễ
Chỉ cần sửa đoạn:
Tmp1 = tArr1(i, j): Tmp2 = tArr2(i, j)
thành:
Tmp1 = tArr1(i, j): Tmp2 = Left(tArr2(i, j), 3)
Các yêu cầu còn lại:
- Gom CHƯƠNG TRÌNH và NGÀY CHIẾU vào chung 1 cell (như chao buoi sang(Mon - Tue - Wed - Fri - Sat - Sun - Thu).... )
- Rút gọn chuổi trong NGÀY CHIẾU theo kiểu chao buoi sang(Mon ---> Sun).... hoặc chao buoi sang(Mon ---> Thu, Sun)...
Các yêu cầu này làm vẫn được nhưng đổi lại sẽ làm cho tốc độ code giảm đi rất nhiều (thậm chí là rất.. rất... nhiều).... Lý do vì sau khi code chạy xong ta lại phải chạy vòng lập lần nữa để xử lý chuổi (ít nhất là 2 vòng lập) ---> Vì thế mà tôi sẽ làm vầy:
- CHƯƠNG TRÌNH và NGÀY CHIẾU tôi để riêng 2 cột
- Có NGÀY CHIẾU nào, liệt kê ngày ấy (dù sao tách còn 3 ký tự thì chuổi cũng chẳng dài bao nhiêu, tối đa cũng chỉ có 7 từ)
----------------
Bạn nghĩ sao?
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, Cách2 theo yêu cầu của bác.
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.
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)
Học tại đây là ngon lành rồi!
Cách đây 3 năm, khi tôi chưa biết gì, tôi đã học với sư phụ SA_DQ và sư phụ ptm0412 tại đây:
Chập chững đến VBA!
Giới thiệu Cơ bản về vòng lặp For . . . next
Bạn cũng nên vào đây nghiên cứu đi (ngoài ra có thể mua sách do GPE phát hành) ---> Sớm muộn bạn cũng thành cao thủ mà thôi
LÀM GÌ MÀ HỌC CHEN NGANG NHƯ VẬY ĐƯỢCBác cũng bó tay thì em sao mà mơ làm được. Dù sao cũng cảm ơn bác nhiều.
Còn việc học, do em không có nhiều thời gian lên mạng nên muốn học trực tiếp bác cho nhanh (sách thì em có đủ rồi, mua ở ngòai và mua trên GPE nhưng toàn sách căn bản không à, em xem 1 ngày là xong). Bác biết gì thì dạy em cái đó thôi (vì em cũng hâm mộ bác), tất nhiên em học phải trả học phí rồi ^^. Được không bác ? Em đang muốn học từ những người như bác cho nhanh (tiết kiệm thời gian).
LÀM GÌ MÀ HỌC CHEN NGANG NHƯ VẬY ĐƯỢC
ĐƠN GIẢN NHƯ VIẾT THƯ CŨNG CẦN CÓ GỬI AI RỒI MỚI ĐẾN NỘI DUNG CHỨ.
BẠN ĐỊNH LÀM THEO PHIM CHƯỞNG CỦA HỒNG KÔNG À. TÉ XUỐNG NÚI LƯỢM ĐƯỢC BÍ KÍP , SAU ĐÓ TRỞ THÀNH CAO THỦ
HI HI
BẠN NÊN VÀO LINK NÀY RỒI SẼ CAO THỦ THÔI
http://www.giaiphapexcel.com/forum/showthread.php?6354-Giới-thiệu-Cơ-bản-về-vòng-lặp-For-.-.-.-next
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ì . 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.
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
Đạ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 ĐỘ NHANHChào các bạn,
Mình mới tham gia học về VBA, cũng xin tham gia đóng góp 1 phần.
Em làm hơi dài dòng tí
Bước 1: tỪ dữ liệu ==> new format
Bước 2: New format ==> Tổng hợp
Các anh chị test thử và cho em nhận xét nhe.
Cám ơn các anh chị nhiều
File gốc đâyAnh cho em xin 300.000 dòng dữ liệu, em sẽ chạy thử xem.
Em chưa thử 300.000 dòng ạ.
Cho em xin file với
Cám ơn anh nhiều
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2