Người mới học VBA, gặp khó khăn: Cú pháp, lý luận, thuật toán trong VBA thì vào đây cùng học! (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Cô Bé Dễ Thương

Thành viên thường trực
Tham gia
30/9/16
Bài viết
223
Được thích
48
Giới tính
Nữ
Các bạn cùng giống vấn đề như mình, xin hãy chỉ post bài tóm lược và trọng tâm nhất có thể (ngán nhất nhưng phải trọng tâm, xin cảm ơn)
Xin phép ban điều hành GPE cho cháu lập chủ đề này! Khi học VBA cháu thấy khó tìm và không tự nghĩ ra được cú pháp và lý luận dùng trong lập trình VBA.
Chăm đọc code cũng chỉ tìm hiểu được cú pháp và lý luận trong code nhưng đa phần là 50-50 không tìm thấy và nghĩ ra được. Vấn đề này quả là khó với người mới học code.
Mong chủ đề này được các bậc tiền bối chỉ dạy cho cháu(em) để có chút vốn để mày mò học code. Xin cảm ơn tất cả thật nhiều ạ!
(các bạn cùng giồng vấn đề như mình xin hãy post bài theo kiểu như mình ở dưới)
PHP:
Xin mở đầu bằng câu hỏi mà cháu(em) tìm kiếm mãi không thấy để bắt chước:
===================================================
Dim Rng1 as Range, Rng2 as Range, Rng4 as Range, Rng5 as Range
Dim rg as Range ,Rng as Range
===================================================
Cháu muốn gộp các bảng dữ liệu có cùng cấu trúc: Rng1, Rng2 , Rng3, Rng4, Rng5 thành 1 bảng. Mục đích để có thể dùng biến rg dùng vòng lặp For Each
duyệt từ Rng1 rồi đến Rng2 rồi đến Rng3 rồi đến Rng4 rồi đến Rng5. Hậu quả là phải viết ra 5 Sud để duyệt từng cái 1,nếu không gộp được các
Rng1,Rng2,Rng3,Rng4,Rng5 thành 1 bảng.
For Each rg In (Tất cả Rng1 và Rng2  và Rng3  và Rng4 và Rng5).Rows
................................................
Next rg
===================================================
Vậy cú pháp để cho biến rg duyệt "Tất cả các Rng1 và Rng2  và Rng3  và Rng4 và Rng5" trong một vòng lặp này là gì ạ?[CODE]
 
Lần chỉnh sửa cuối:
Xin phép ban điều hành GPE cho cháu lập chủ đề này! Khi học VBA cháu thấy khó tìm và không tự nghĩ ra được cú pháp và lý luận dùng trong lập trình VBA.
Chăm đọc code cũng chỉ tìm hiểu được cú pháp và lý luận trong code nhưng đa phần là 50-50 không tìm thấy và nghĩ ra được. Vấn đề này quả là khó với người mới học code.
Mong chủ đề này được các bậc tiền bối chỉ dạy cho cháu(em) để có chút vốn để mày mò học code. Xin cảm ơn tất cả thật nhiều ạ!
(các bạn cùng giồng vấn đề như mình xin hãy post bài theo kiểu như mình ở dưới)
PHP:
Xin mở đầu bằng câu hỏi mà cháu(em) tìm kiếm mãi không thấy để bắt chước:
===================================================
Dim Rng1 as Range, Rng2 as Range, Rng4 as Range, Rng5 as Range
Dim rg as Range ,Rng as Range
===================================================
Cháu muốn gộp các bảng dữ liệu có cùng cấu trúc: Rng1, Rng2 , Rng3, Rng4, Rng5 thành 1 bảng. Mục đích để có thể dùng biến rg dùng vòng lặp For Each
duyệt từ Rng1 rồi đến Rng2 rồi đến Rng3 rồi đến Rng4 rồi đến Rng5. Hậu quả là phải viết ra 5 Sud để duyệt từng cái 1,nếu không gộp được các
Rng1,Rng2,Rng3,Rng4,Rng5 thành 1 bảng.
For Each rg In (Tất cả Rng1 và Rng2  và Rng3  và Rng4 và Rng5).Rows
................................................
Next rg
===================================================
Vậy cú pháp để cho biến rg duyệt "Tất cả các Rng1 và Rng2  và Rng3  và Rng4 và Rng5" trong một vòng lặp này là gì ạ?[CODE]
Union(Rng1,Rng2,Rng3,...)
 
Upvote 0
Lần chỉnh sửa cuối:
Upvote 0
Chỉ vậy thôi á? Rồi sao nữa? Đặt tiêu đề nghe đầy tính triết lý mà thực tế là hỏi về hàm gộp Range!
Em hoặc ai đó đang học vba thì post chung vào 1 chỗ tiện cho dễ tổng hợp. Nếu có thể thạo rồi em lại viết vào đây cách dùng những cú pháp và lý luận mà em học được.
Thứ nữa là vừa học và thực hành đến đâu có vướng mắc quá mới hỏi ạ!
Em đang dùng Union đúng như bài #3 nhưng khi tạo Key cho Dictionary thì nó lại chỉ hiểu là của mỗi ông thứ nhất. Vừa thực hành thì nảy sinh vấn đề:
1.Không biết Key có tạo ra được từ các bảng trong Union hay là Key chỉ tạo được ở 1 bảng đơn độc thôi?
2. Ghép được Range bằng Union. Với Array có ghép được không?
Xin giúp em ạ!
(Dim ,Set , dữ liệu chuẩn chạy không lỗi mà lại ra mỗi Key bảng đầu tiên, hic chết dở)
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn này cần học lý thuyết cơ bản đã.
Nắm được lý thuyết thì những théc méc kia mặc nhiên sẽ hiểu.
 
Upvote 0
Bạn này cần học lý thuyết cơ bản đã.
Nắm được lý thuyết thì những théc méc kia mặc nhiên sẽ hiểu.
Mong bác hoan hỉ chỉ cho, mỗi thứ 1 ít, mỗi người 1 ít. Vì hiện cháu cũng gắng không hỏi theo kiểu đưa bài lên mà có găng hỏi ít nhất có thể. Vậy là cũng có tiến bộ phải không ạ?
 
Upvote 0
Chắc chủ bài đăng đang tính luyện giải thuật. Mà cái thứ này thì khó hướng dẫn . . . .
Mà theo mình thì xông ngay vô Dictionary làm chi cho tốn sức; Ngược lại, theo mình nên xài những thứ phổ thông cho những trường hợp gây cấn. Lúc đó mới tích lũy giải thuật hay!

Chủ bài đăng thử đến đây & giải theo hướng Dictionary xem sao: https://www.giaiphapexcel.com/diendan/threads/Đánh-số-thứ-tự-theo-ngày-tháng-và-theo-từng-group.154495/ (Ở đó cũng có thêm cách xài phương thức Union() đấy)
 
Lần chỉnh sửa cuối:
Upvote 0
Bác @SA_DQ dậy sớm thế. Nhân bác đang xanh xanh cháu hỏi tý:
Union các Range có cột bằng nhau, nhưng khác số dòng thì có Union đc không. Vì cháu dùng Union trường hợp này là để tạo ra vùng có dữ liệu không trùng lặp (Dictionary). Sau đó mới tạo Key cho Dict nhưng Union rồi mà nó lại hiểu có 1 Range đầu tiên.
 
Lần chỉnh sửa cuối:
Upvote 0
Bác @SA_DQ dậy sớm thế. Nhân bác đang xanh xanh cháu hỏi tý:
Union các Range có cột bằng nhau, nhưng khác số dòng thì có Union đc không. Vì cháu dùng Union trường hợp này là để tạo ra vùng có dữ liệu không trùng lặp (Dictionary). Sau đó mới tạo Key cho Dict nhưng Union rồi mà nó lại hiểu có 1 Range đầu tiên.
Do bạn hỏi nhỏ giọt, không có ví dụ cụ thể, dữ liệu ra sao nên chỉ có gợi ý cho bạn thế này.
Mã:
For Each sCell In Union(Rng1, Rng2, Rng3...).Areas
    MsgBox sCell.Address
Next
Việc còn lại là tùy biến và xử lý.
 
Upvote 0
Union các Range có cột bằng nhau, nhưng khác số dòng thì có Union đc không. Vì cháu dùng Union trường hợp này là để tạo ra vùng có dữ liệu không trùng lặp (Dictionary). Sau đó mới tạo Key cho Dict nhưng Union rồi mà nó lại hiểu có 1 Range đầu tiên.
Đã kêu bạn học lý thuyết cơ bản đã.
Bây giờ mình cứ xoắn quẩy Range, Array, Dictionary vào với nhau làm gì, kết cục không giải quyết gì cả.
Mọi thứ đều bắt nguồn từ khái niệm, định nghĩa. Nắm được cái đó đã mới tính tiếp.
 
Upvote 0
Trong chủ đề bên kia tôi có đề nghị phương pháp suy luận và thực hành lập trình. Bản chất việc suy luận là tìm ra thuật toán phù hợp (chưa cần tối ưu). Nhắc lại và bổ sung như sau:

Phướng pháp là các bước thế này:
1. Tự suy nghĩ về thuật toán (cái gọi là ní nuận ấy): Các bước tuần tự để giải bài toán
2. Ghi ra giấy, nghĩ lại vài lần nữa, chỉnh sửa hoặc sắp xếp lại nếu cần
3. Đối với từng bước, tìm công cụ phù hợp: For Next hay Do, Xài Dict hay không, Nếu xài Dict thì item nên là giá trị gì, xài mảng hay phải xài cell, có cần mảng kết quả không, xài If Then hay xài Select Case, ...
Muốn biết chắc sử dụng công cụ nào là phù hợp thì phải nắm vững lý thuyết cơ bản của từng cấu trúc đó. Đây là điều @befaint nhắc 2 lần
4. Tự viết câu lệnh dựa vào ní nuận đã ghi trên giấy, không copy từng dòng lệnh của người khác, trừ khi biết chính xác là câu lệnh copy đó phù hợp với ní nuận. Việc này để rèn cú pháp.
5. Gán giá trị vào biến xong, xem xét việc sử dụng giá trị biến như thế nào: Tăng dần, cộng dồn, sử dụng lại chỗ này chỗ khác, ...
6. Viết xong chạy thử từng dòng lệnh: Nhấn F8 để chạy từng câu lệnh.
- Sau mỗi câu lệnh, rà chuột vào các biến để xem giá trị tức thời của biến (chỉ xem được biến đơn, không xem được biến mảng hoặc giá trị mảng, giá trị range nhiều ô). Hoặc dùng câu lệnh Debug.Print để xem
- Đối chiếu với giá trị mong muốn
- Nếu code có cấu trúc If, thì xem lệnh chạy đến điều kiện của If rồi chạy thẳng đến else, hay chạy các dòng lệnh của if? Việc này đúng hay sai so với mong muốn?
- Nếu câu lệnh để gán kết quả, thì kết quả có đúng ý chưa
- Nếu có vòng lặp, thì xét ít nhất 3 vòng lặp xem các câu lệnh có chạy đúng ý muốn chưa


TB:
Ní nuận là từ không chính xác trong trường hợp này, Phải nói là tư duy thuật toán
 
Lần chỉnh sửa cuối:
Upvote 0
Đã kêu bạn học lý thuyết cơ bản đã.
Bây giờ mình cứ xoắn quẩy Range, Array, Dictionary vào với nhau làm gì, kết cục không giải quyết gì cả.

TB:
Ní nuận là từ không chính xác trong trường hợp này, Phải nói là tư duy thuật toán
Vâng!
Có 2 chủ đề đã đưa lên GPE đc các bác chỉ dạy cho cháu cũng làm Dictionary cơ ban rồi. Giờ muốn mở rộng ra. Trước là 1 vùng dữ liệu gồm những giá trị duy nhất từ đó có Key của Dict, giờ mở rộng ra gồm nhiều vùng dữ liệu có giá trị duy nhất để tạo Key của Dict.
Hiện cháu xử lý:
1. Có 5 vùng thì làm 5 cai Sub để thực hiện cho 5 vùng(có khả năng lên đến 100 vùng như vậy, tương đương 100 Sub, và file excel nặng hơn và có quá nhiều Sub, và nhiều cột nhiều bảng phụ trên Sheets
2. Trên sheet tạo ra 1 Sub để gộp các vùng đó lại làm 1 bảng. Rồi dùng Dictionary
3. Gộp luôn 5 bảng bằng code rồi xử lý bằng 1 Sub. Hiện cách này Union xử lý cách này cháu chưa làm đc.
Khóc: Cách 2 có lẽ là tối ưu nhất đến hiện tại chăng, hay là có thể có cách 3 chăng?
Chỉ bậc thậy ở GPE mới chỉ được, đọc không và trình hiện tại không xử lý đc
 
Lần chỉnh sửa cuối:
Upvote 0
Vâng!
Có 2 chủ đề đã đưa lên GPE đc các bác chỉ dạy cho cháu cũng làm Dictionary cơ ban rồi. Giờ muốn mở rộng ra. Trước là 1 vùng dữ liệu gồm những giá trị duy nhất từ đó có Key của Dict, giờ mở rộng ra gồm nhiều vùng dữ liệu có giá trị duy nhất để tạo Key của Dict.
Hiện cháu xử lý:
1. Có 5 vùng thì làm 5 cai Sub để thực hiện cho 5 vùng
2. Trên sheet tạo ra 1 Sub để gộp các vùng đó lại làm 1 bảng. Rồi dùng Dictionary
3. Gộp luôn 5 bảng bằng code rồi xử lý bằng 1 Sub. Hiện cách này Union xử lý cách này cháu chưa làm đc.
Dùng Union ghép lung tung dễ bị nầy bị kia
Dùng mảng lưu dữ liệu các vùng. Ví dụ có 3 vùng
sArr=array(range("A3:B5"),range("C6:G10"),range("X20"Z50"))
for i=0 to ubound(sArr)
for each ....

next
next i
 
Upvote 0
Dùng Union ghép lung tung dễ bị nầy bị kia
Dùng mảng lưu dữ liệu các vùng. Ví dụ có 3 vùng
sArr=array(range("A3:B5"),range("C6:G10"),range("X20"Z50"))
for i=0 to ubound(sArr)
for each ....

next
next i
Vâng. Cháu cảm ơn và làm theo ạ
Nếu không được xin phép post bài lên sau ạ!
 
Upvote 0
Xin phép được đặt câu hỏi chung chủ để với chủ bài đăng vì bản thân em cũng là người mới tiếp xúc làm quen với VBA và đang gặp 1 bài khó chưa giải quyết được, mong nhận được chút chỉ giáo của các admin GPE.
Bài toán của em là quản lý kho, trong đó có phần quản lý tổng đơn xuất, nhập trong khoảng thời gian xác định, sau đó show kết quả ra ngay trên userform. phần nhập dữ liệu giao dịch (là nhâp hay xuất), số lượng hàng hóa cụ thể em đã làm được. Xong đến đoạn làm thế nào để viết code đếm số lượng đơn nhập/xuất trong khoảng thời gian xác định và show nó lên thì e mày mò mãi ko đc. Sau đây là đoạn code em đã viết thử và bị báo lỗi:

Sub tinh_tong_don_xuat_nhap()

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Tinh_tong_don")

ws.Cells.Clear

ThisWorkbook.Sheets("Xuat_nhap").Range("C:C").Copy ws.Range("A1")
ThisWorkbook.Sheets("Xuat_nhap").Range("D:D").Copy ws.Range("B1")

ws.ActiveSheet.Range("$A$1:$B$12").RemoveDuplicates (ws.Range("A"))

'''Tinh_tong_nhap
Dim wsb As Worksheet
Set wsb = ThisWorkbook.Sheets("Bao_cao")

wsb.Range("C7") = "=COUNTIFS(Tinh_tong_don!A:A,""NK*"",Tinh_tong_don!B:B,"">=""&Bao_cao!C1,Tinh_tong_don!B:B,""<=""&Bao_cao!C2)"
wsb.Range("C8") = "=COUNTIFS(Tinh_tong_don!A:A,""XK*"",Tinh_tong_don!B:B,"">=""&Bao_cao!C1,Tinh_tong_don!B:B,""<=""&Bao_cao!C2)"

End Sub

Kính mong các cao nhân giúp em sửa lại cho đúng. Em xin chân thành cảm ơn!!!
Em cũng xin gửi kèm file chi tiết ạ!
 

File đính kèm

Upvote 0
Được nhờ chú @ptm0412(mong chú phê vài dòng giúp cháu ạ) và các bác mới được đến đây ạ!
Bài dưới đây hiện có 3 cách giải với Dictionary:
1. Key tao ra ở từng bảng có giá trị duy nhất.Nghĩa là có 6 bảng thì có 6 Sub. Sau đó thêm một Sub nữa để ghép các cột kết quả lại với nhau. Đồng nghĩa với viêc dùng tới 7 Sub và 6 cột phụ
2. Gộp tất cả các bảng lại thành 1 bảng duy nhất. Sau đó mới tạo Key. Cách này phải dùng tới 2 Sub và trên Sheets phải thêm dữ liệu 1 bảng
3. Dùng chỉ 1 Sub và không phát sinh cột phụ.Cách 3 hiện chịu thua và cầu cứu sự giúp đỡ của các thầy!
(Hình minh họa cách 2 và code gộp bảng cách 2, và file đính kèm đã hoàn thành 2 cách)
cach2.jpg
Gôp bảng theo cách nhà quê, nông dân, chân đất mắt toét này của em thì xác định tay to hơn chân. Nhưng nom cũng được!
PHP:
Sub ghep_bang()
Dim Rng As Range, RArr()
Dim Rng1 As Range, Rng2 As Range, Rng3 As Range, _
Rng4 As Range, Rng5 As Range, Rng6 As Range
LR1 = Application.WorksheetFunction.CountA(Sheet3.Range("F:F")) - 2
lR2 = Application.WorksheetFunction.CountA(Sheet3.Range("j:j")) - 2
lR3 = Application.WorksheetFunction.CountA(Sheet3.Range("n:n")) - 2
lR4 = Application.WorksheetFunction.CountA(Sheet3.Range("r:r")) - 2
lR5 = Application.WorksheetFunction.CountA(Sheet3.Range("v:v")) - 2
lR6 = Application.WorksheetFunction.CountA(Sheet3.Range("z:z")) - 2

Set Rng1 = Sheet3.Range("F10:H" & LR1 + 9)
Set Rng2 = Sheet3.Range("j10:l" & lR2 + 9)
Set Rng3 = Sheet3.Range("n10:p" & lR3 + 9)
Set Rng4 = Sheet3.Range("r10:t" & lR4 + 9)
Set Rng5 = Sheet3.Range("v10:x" & lR5 + 9)
Set Rng6 = Sheet3.Range("z10:ab" & lR6 + 9)
For i = 1 To LR1 + lR2 + lR3 + lR4 + lR5 + lR6
Set Rng_TT = Sheet3.Range("ad" & i + 9)
Set Rng_Name = Sheet3.Range("ae" & i + 9)
Set Rng_Mon = Sheet3.Range("af" & i + 9)
Rng_TT.Value = i
    If (i <= LR1) Then
            Rng_Name.Value = Rng1.Cells(i, 2)
            Rng_Mon.Value = Rng1.Cells(i, 3)
    End If
    If (i > LR1 And i <= LR1 + lR2) Then
            Rng_Name.Value = Rng2.Cells(i - LR1, 2)
            Rng_Mon.Value = Rng2.Cells(i - LR1, 3)
    End If
    If (i > LR1 + lR2 And i <= LR1 + lR2 + lR3) Then
            Rng_Name.Value = Rng3.Cells(i - LR1 - lR2, 2)
            Rng_Mon.Value = Rng4.Cells(i - LR1 - lR2, 3)
    End If
    If (i > LR1 + lR2 + lR3 And i <= LR1 + lR2 + lR3 + lR4) Then
            Rng_Name.Value = Rng4.Cells(i - LR1 - lR2 - lR3, 2)
            Rng_Mon.Value = Rng4.Cells(i - LR1 - lR2 - lR3, 3)
    End If
    If (i > LR1 + lR2 + lR3 + lR4 And i <= LR1 + lR2 + lR3 + lR4 + lR5) Then
            Rng_Name.Value = Rng5.Cells(i - LR1 - lR2 - lR3 - lR4, 2)
            Rng_Mon.Value = Rng5.Cells(i - LR1 - lR2 - lR3 - lR4, 3)
    End If
    If (i > LR1 + lR2 + lR3 + lR4 + lR5 And i <= LR1 + lR2 + lR3 + lR4 + lR5 + lR6) Then
            Rng_Name.Value = Rng6.Cells(i - LR1 - lR2 - lR3 - lR4 - lR5, 2)
            Rng_Mon.Value = Rng6.Cells(i - LR1 - lR2 - lR3 - lR4 - lR5, 3)
    End If
Next i
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Xin phép được đặt câu hỏi chung chủ để với chủ bài đăng vì bản thân em cũng là người mới tiếp xúc làm quen với VBA.................
Mình bảo này, chỗ nào bạn cần chèn code khi post bài lên GPE bạn làm như sau:
CODE=php
Nội dung gì cũng được
/CODE
Nhớ thêm dấu [ ] bọc lấy 2 từ màu đỏ là được nhé
Làm thế các thầy dễ nhìn hơn. Ở đây comment với mình cho vui!
(Hóng cách 3 bài #17)
 
Lần chỉnh sửa cuối:
Upvote 0
Upvote 0
Được nhờ chú @ptm0412(mong chú phê vài dòng giúp cháu ạ) và các bác mới được đến đây ạ!
Bài dưới đây hiện có 3 cách giải với Dictionary:
1. Key tao ra ở từng bảng có giá trị duy nhất.Nghĩa là có 6 bảng thì có 6 Sub. Sau đó thêm một Sub nữa để ghép các cột kết quả lại với nhau. Đồng nghĩa với viêc dùng tới 7 Sub và 6 cột phụ
2. Gộp tất cả các bảng lại thành 1 bảng duy nhất. Sau đó mới tạo Key. Cách này phải dùng tới 2 Sub và trên Sheets phải thêm dữ liệu 1 bảng
3. Dùng chỉ 1 Sub và không phát sinh cột phụ.Cách 3 hiện chịu thua và cầu cứu sự giúp đỡ của các thầy!
(Hình minh họa cách 2 và code gộp bảng cách 2, và file đính kèm đã hoàn thành 2 cách)
View attachment 255205
Gôp bảng theo cách nhà quê, nông dân, chân đất mắt toét này của em thì xác định tay to hơn chân. Nhưng nom cũng được!
PHP:
Sub ghep_bang()
Dim Rng As Range, RArr()
Dim Rng1 As Range, Rng2 As Range, Rng3 As Range, _
Rng4 As Range, Rng5 As Range, Rng6 As Range
LR1 = Application.WorksheetFunction.CountA(Sheet3.Range("F:F")) - 2
lR2 = Application.WorksheetFunction.CountA(Sheet3.Range("j:j")) - 2
lR3 = Application.WorksheetFunction.CountA(Sheet3.Range("n:n")) - 2
lR4 = Application.WorksheetFunction.CountA(Sheet3.Range("r:r")) - 2
lR5 = Application.WorksheetFunction.CountA(Sheet3.Range("v:v")) - 2
lR6 = Application.WorksheetFunction.CountA(Sheet3.Range("z:z")) - 2

Set Rng1 = Sheet3.Range("F10:H" & LR1 + 9)
Set Rng2 = Sheet3.Range("j10:l" & lR2 + 9)
Set Rng3 = Sheet3.Range("n10:p" & lR3 + 9)
Set Rng4 = Sheet3.Range("r10:t" & lR4 + 9)
Set Rng5 = Sheet3.Range("v10:x" & lR5 + 9)
Set Rng6 = Sheet3.Range("z10:ab" & lR6 + 9)
For i = 1 To LR1 + lR2 + lR3 + lR4 + lR5 + lR6
Set Rng_TT = Sheet3.Range("ad" & i + 9)
Set Rng_Name = Sheet3.Range("ae" & i + 9)
Set Rng_Mon = Sheet3.Range("af" & i + 9)
Rng_TT.Value = i
    If (i <= LR1) Then
            Rng_Name.Value = Rng1.Cells(i, 2)
            Rng_Mon.Value = Rng1.Cells(i, 3)
    End If
    If (i > LR1 And i <= LR1 + lR2) Then
            Rng_Name.Value = Rng2.Cells(i - LR1, 2)
            Rng_Mon.Value = Rng2.Cells(i - LR1, 3)
    End If
    If (i > LR1 + lR2 And i <= LR1 + lR2 + lR3) Then
            Rng_Name.Value = Rng3.Cells(i - LR1 - lR2, 2)
            Rng_Mon.Value = Rng4.Cells(i - LR1 - lR2, 3)
    End If
    If (i > LR1 + lR2 + lR3 And i <= LR1 + lR2 + lR3 + lR4) Then
            Rng_Name.Value = Rng4.Cells(i - LR1 - lR2 - lR3, 2)
            Rng_Mon.Value = Rng4.Cells(i - LR1 - lR2 - lR3, 3)
    End If
    If (i > LR1 + lR2 + lR3 + lR4 And i <= LR1 + lR2 + lR3 + lR4 + lR5) Then
            Rng_Name.Value = Rng5.Cells(i - LR1 - lR2 - lR3 - lR4, 2)
            Rng_Mon.Value = Rng5.Cells(i - LR1 - lR2 - lR3 - lR4, 3)
    End If
    If (i > LR1 + lR2 + lR3 + lR4 + lR5 And i <= LR1 + lR2 + lR3 + lR4 + lR5 + lR6) Then
            Rng_Name.Value = Rng6.Cells(i - LR1 - lR2 - lR3 - lR4 - lR5, 2)
            Rng_Mon.Value = Rng6.Cells(i - LR1 - lR2 - lR3 - lR4 - lR5, 3)
    End If
Next i
End Sub
Hình như bạn ghiền Dic hay sao ấy chứ, Cách 3 của bạn là tập hợp lại tất cả các bảng chứ không phải loại trùng (vì tất nhiên dạy cấp khác nhau thì thầy cô có thể trùng tên nhưng chắc chắn phải là 2 người khác nhau - Ông A dạy cấp 1 khác ông A dạy cấp 2). Mà đã không loại trùng thì không nhất thiết phải dùng dic trong trường hợp này.
Vòng lặp for là đủ:
Mã:
Option Explicit
Sub Cach3()
Dim I As Long, J As Long, K As Long, Lr As Long
Dim U1 As Long, U2 As Long
Dim sArr(), dArr()
With Sheets("Cach3")
    Lr = .Range("F10:AB1000").Find("*", , xlValues, , xlByRows, xlPrevious).Row
    sArr = .Range("F10:AC" & Lr).Value
    U1 = UBound(sArr, 1): U2 = UBound(sArr, 2)
    ReDim dArr(1 To U1 * U2 / 4, 1 To 3)
    For I = 2 To U2 Step 4 ' cot
        For J = 1 To U1 'dong
            If sArr(J, I) <> "" Then
                    K = K + 1
                    dArr(K, 1) = K
                    dArr(K, 2) = sArr(J, I)
                    dArr(K, 3) = sArr(J, I + 1)
            End If
        Next
    Next
    .Range("B10").Resize(10000, UBound(dArr, 2)).ClearContents
    .Range("B10").Resize(K, UBound(dArr, 2)) = dArr
End With
End Sub
 
Upvote 0
Hình như bạn ghiền Dic hay sao ấy chứ, Cách 3 của bạn là tập hợp lại tất cả các bảng chứ không phải loại trùng (vì tất nhiên dạy cấp khác nhau thì thầy cô có thể trùng tên nhưng chắc chắn phải là 2 người khác nhau - Ông A dạy cấp 1 khác ông A dạy cấp 2). Mà đã không loại trùng thì không nhất thiết phải dùng dic trong trường hợp này.
Vòng lặp for là đủ
Dạ. Em nghiện VBA rồi ạ!
Cách của bác có kiến thức mảng liên quan đến bài đang làm, em thích lắm! Ứng dụng được nhiều!
PHP:
With Sheets("Cach3")
    Lr = .Range("F10:AB1000").Find("*", , xlValues, , xlByRows, xlPrevious).Row
    sArr = .Range("F10:AC" & Lr).Value
    U1 = UBound(sArr, 1): U2 = UBound(sArr, 2)
    ReDim dArr(1 To U1 * U2 / 4, 1 To 3) 'Không biêt sao bác lại chia cho 4 chỗ này, xin chỉ giúp ạ?
Nhưng hiện với Dict em còn vướng chỗ cách 3 bài #17,Bác thạo Dict nếu có thời gian bác thử xem sao?
Tài nguyên diễn đàn nhiều quá! Em không tìm thấy chủ đề tương tự cách 3 bài #17 để bắt chước. Còn nghĩ ra thì chưa đủ khả năng ạ
 
Lần chỉnh sửa cuối:
Upvote 0
A. Không biêt sao bác lại chia cho 4 chỗ này, xin chỉ giúp ạ?
B. Cách 2. Gộp tất cả các bảng lại thành 1 bảng duy nhất. Sau đó mới tạo Key. Cách này phải dùng tới 2 Sub và trên Sheets phải thêm dữ liệu 1 bảng
C. Cách 3 ...

A. Code bài 21 là cách không chính thống lắm (hơi tà đạo và lợi dụng cấu trúc dữ liệu, không tổng quát):
- Tìm dòng cuối bằng cách tìm * ByRow: Nếu dữ liệu rời rạc và/ khác sheet thì không dùng được
- Chia 4 vì cứ mỗi bảng chiếm 4 cột, tổng cột x tổng dòng chia 4 = số dòng 1 cột (và là số dòng lớn nhất xác định được khi Find. Nếu dữ liệu rời rạc thì cũng không làm được
Tốt nhất người mới học đừng làm kiểu không chính thống.
B. Cách 2: Ý tưởng thì hay nhưng làm thì dở.
1. Sub ghep_bang
- Hạn chế dùng Application.WorsheetFunction nếu có cách khác thuần VBA. Ngay cả dùng hàm Excel trên sheet mà CountA nguyên cột là đã đáng đánh đòn rồi, lại còn trừ 2, làm sao biết chắc là trừ 2 khi bắt đầu từ dòng 10? 9 dòng trên ai bảo đảm là luôn luôn chỉ có 2 ô chứa dữ liệu? Tại sao việc đơn giản là end(xlUp).Row thì lại không làm?
- Định nghĩa Rng_TT làm gì rồi không xài?
- Tại sao không dùng mảng 3 cột hoặc 2 cột, mà lại dùng Range và 3 Range? Nếu dùng mảng thì thậm chí vòng lặp tạo Dict không cần gán xuống sheet và đọc trực tiếp trên mảng.
- Khi đã có 5 khoảng đếm và dùng If để tách ra các khoảng khác nhau, thì phải biết cấu trúc If có tính năng loại trừ dần dần, không ai làm 5 cái If và If kiểu a >=X2 and a <=X3 cả. Cách đúng là:
Mã:
If a <X1 Then
   ..
ElseIf a< X2 Then
  ...
ElseIf a < X3 Then
  ...
Else
   ...
End If
Hoặc dùng cấu trúc Select Case
Mã:
Select Case a
Case Is < X1
  ..
Case Is < X2
...
Case Else
End Select
2. Sub dict_thayday()
- Dữ liệu đã duy nhất chưa mà không đặt điều kiện, cứ thế add tất tần tật vào Dict? Nếu 1 thầy dạy 2 môn cho nhiều lớp thì sao? Như lão chết tiệt dạy cho 2 con nhãi cháu gọi bằng chú môn VBA, dạy 3 anh chàng khác môn vẽ biểu đồ, dạy 15 anh chị nọ về Power query, ...
- item có mỗi một phần tử mà cũng xài Array(Sample(I, 3)) là sao? Chưa nói việc cứ đặt tên biến là Sample! Sample là mẫu để thực hiện cái gì khác mà? Cơ bản đặt tên biến mà không biết nữa!
- Nói về SData: Nếu tên thầy có trong Dict thì điền môn dạy (trả lương), còn thầy không có môn dạy thì bỏ trống không trả lương à? Rồi nếu thầy có môn dạy (có trong Dict) mà không có trong danh sách cột B cũng mặc kệ? Đây là do đề bài không rõ ràng, dữ liệu không rõ ràng, yê ucầu không rõ ràng
C. Cách 3
Thôi đừng nói cách 3 cho mệt. Ở trên đã "may quá" với Union ở bài 3, dạ vâng với Array(rng1, rng2, ...) ở bài 15 mà không thử làm theo cái nào.

TB
Việc lớn nhất:
Tự ra cái đề để tự làm thì cũng phải đặt cái đề cho hợp lý,
- yêu cầu ở ngành nghề nào, của ông bộ trưởng nào đòi mà có 1 danh sách giáo viên chưa biết dạy môn gì phải lập trình để điền môn?
- Tên có thể trùng bất cứ ngành nghề nào, luôn luôn phải có mã. Đặt đề bài thì phải từ dữ liệu hợp lý (có thực) và đúng chuẩn (có mã), và yêu cầu ra báo cáo không phải là 1 báo cáo ngu ngơ cho 1 ông sếp ngu ngơ.
 
Upvote 0
Union các Range có cột bằng nhau, nhưng khác số dòng thì có Union đc không. Vì cháu dùng Union trường hợp này là để tạo ra vùng có dữ liệu không trùng lặp (Dictionary). Sau đó mới tạo Key cho Dict nhưng Union rồi mà nó lại hiểu có 1 Range đầu tiên.
Nhiều người, và cả bạn, có thói quen rất xấu là chỉ dùng ảnh và nước bọt nên người khác muốn giúp nhưng không hiểu ý. Nếu đính kèm code thì dễ rồi. Chỉ cần nhìn vào code ai cũng thấy code làm gì rồi.

Do bạn không có code nên tôi đoán mò là vấn đề ở chỗ là bạn chưa hiểu rõ đối tượng RANGE.

Thường thì bạn chọn một vùng hình chữ nhật có ít nhất 1 ô (cell). Nhiều khi bạn hiện InputBox để người ta có thể chọn nhiều vùng TÁCH RỜI NHAU như AD10:AF38, B10: D19. Như vậy Range trong trường hợp tổng quát là một tập hợp 1 hoặc nhiều vùng LIỀN HÌNH CHỮ NHẬT. Mỗi vùng như thế có thể có 1 hoặc nhiều cell và đeo huy hiệu (được gọi là) AREA. Trong vd. ở trên thì nếu
Mã:
Set Sample = Union(Sheet3.Range("AD10:AF38"), Sheet3.Range("B10:D19"))
thì Sample có 2 AREA. AREA 1 là Sheet3.Range("AD10:AF38") và có 29 dòng, AREA 2 là Sheet3.Range("B10: D19") có 10 dòng. Trong trường hợp như thế thì vd.
Mã:
For i = 1 To Sample.Rows.Count
...
Next i
code chỉ duyệt AREA 1 là Sheet3.Range("AD10:AF38"). Tôi đoán mò là bạn gặp vấn đề do duyệt Range kiểu này.

Trong trường hợp tổng quát thì tùy vào nhu cầu mà có 2 cách duyệt vùng
1. Nhu cầu cần duyệt từng dòng của Range.
Phải duyệt từng AREA và trong mỗi AREA (là vùng liền hình chữ nhật) duyệt từng dòng.
Mã:
Dim i As Long, hichic As Range, vung As Range

Set hichic = Union(Sheet3.Range("AD10:AF15"), Sheet3.Range("B10:D19"))
For Each vung In hichic.Areas
    Debug.Print vung.Address
    For i = 1 To vung.Rows.Count
        Debug.Print vung(i, 2)
    Next i
Next vung

hoặc

Dim i As Long, a As Long, hichic As Range

Set hichic = Union(Sheet3.Range("AD10:AF15"), Sheet3.Range("B10:D19"))
For a = 1 To hichic.Areas.Count
    With hichic.Areas(a)
        Debug.Print .Address
        For i = 1 To .Rows.Count
            Debug.Print .Cells(i, 2)
        Next i
    End With
Next a

2. Nhu cầu cần duyệt từng ô (cell).
Thì duyệt trong 1 vòng lặp vd.
Mã:
Set hichic = Union(Sheet3.Range("AD10:AF15"), Sheet3.Range("B10:D19"))
For Each cell_ In hichic
    Debug.Print cell_.Address
Next

Trong trường hợp tổng quát số AREA của đối tượng hichic là hichic.Areas.Count. AREA 1, tức Sheet3.Range("AD10:AF38"), là hichic.Areas(1), AREA 2 là hichic.Areas(2)
 
Lần chỉnh sửa cuối:
Upvote 0
Mình bảo này, chỗ nào bạn cần chèn code khi post bài lên GPE bạn làm như sau:
CODE=php
Nội dung gì cũng được
/CODE
Nhớ thêm dấu [ ] bọc lấy 2 từ màu đỏ là được nhé
Làm thế các thầy dễ nhìn hơn. Ở đây comment với mình cho vui!
(Hóng cách 3 bài #17)
Vâng, lần sau mình sẽ chú ý hơn ạ ^^~
Bài đã được tự động gộp:

......................................................................................................
Xin thầy hướng dẫn cách sửa cho đúng ạ. Em mới học, thật sự là ko biết gì ạ huhu.... Mong thầy thông cảm cho em kiến thức nông cạn :please:
 
Upvote 0
C. Cách 3
Thôi đừng nói cách 3 cho mệt. Ở trên đã "may quá" với Union ở bài 3, dạ vâng với Array(rng1, rng2, ...) ở bài 15 mà không thử làm theo cái nào.
Cách 4:
- Toàn bộ dùng mảng
Bước 1: Do dữ liệu trên cùng sheet nên tạo 1 mảng là các cột đầu của các bảng dữ liệu: ColumnArr = Array(6, 10, 14, 18, 24, 30)
Bước 2: Dùng vòng lặp 6 vòng, mỗi vòng:
- Lấy dữ liệu 1 khối vào mảng
- Duyệt dữ liệu mảng, add vào Dict, tính SL bán (dữ liệu mới cho chuẩn, không làm dữ liệu và báo cáo ngu ngơ)
Bước 3:
Duyệt dữ liệu cột B: mặt hàng nào có bán thì điền tổng số lượng bán

PHP:
Sub DictExercise()
Dim MaxRw As Long, DataRw As Long, i As Long
Dim DataStore(), ColumnArr, sKey As String
Dim Dict, SArr(), RArr()
Set Dict = CreateObject("Scripting.Dictionary")
ColumnArr = Array(6, 10, 14, 18, 22, 26)
With Sheet3
    For col = 0 To 5
        DataRw = .Cells(1000, ColumnArr(col)).End(xlUp).Row
        DataStore = .Range(.Cells(10, ColumnArr(col)), _
        .Cells(DataRw, ColumnArr(col))).Resize(, 3).Value
        For i = 1 To UBound(DataStore, 1)
            sKey = DataStore(i, 1)
            If Not Dict.exists(sKey) Then
                Dict.Add sKey, DataStore(i, 3)
            Else
                Dict.Item(sKey) = Dict.Item(sKey) + DataStore(i, 3)
            End If
        Next
    Next
    SArr = .Range(.Cells(10, 2), .Cells(1000, 2).End(xlUp)).Value
    ReDim RArr(1 To UBound(SArr, 1), 1 To 1)
    For i = 1 To UBound(SArr, 1)
        If Dict.exists(SArr(i, 1)) Then
            RArr(i, 1) = Dict.Item(SArr(i, 1))
        Else
            RArr(i, 1) = 0
        End If
    Next
    .Range("D10:D1000").ClearContents
    .Range("D10").Resize(UBound(SArr, 1), 1) = RArr
End With
End Sub

1615437249774.png
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Nhiều người, và cả bạn, có thói quen rất xấu là chỉ dùng ảnh và nước bọt nên người khác muốn giúp nhưng không hiểu ý. .................
Do bạn không có code nên tôi đoán mò là vấn đề ở chỗ là bạn chưa hiểu rõ đối tượng RANGE....................

Dim i As Long, a As Long, hichic As Range
Set hichic = Union(Sheet3.Range("AD10:AF15"), Sheet3.Range("B10:D19"))
For a = 1 To hichic.Areas.Count
With hichic.Areas(a)
Debug.Print .Address
For i = 1 To .Rows.Count
Debug.Print .Cells(i, 2)
Next i
End With
Next a
Code cách 3, bài 17: Dùng 1 Sub và không phát sinh cột phụ giải bằng Dictionary, dựa theo hướng dẫn của bác @batman1 ở bài #24
PHP:
Sub dict_thayday_dientenmonhoc_c3_bac_batman1()
Dim Dict, SData As Range
Dim sKey As String, DataRows As Long
Dim Rng1 As Range, Rng2 As Range, Rng3 As Range, Rng4 As Range, _
Rng5 As Range, Rng6 As Range, Sample As Range
Set Rng1 = Sheet3.Range("F10:H12")
Set Rng2 = Sheet3.Range("j10:l14")
Set Rng3 = Sheet3.Range("n10:p13")
Set Rng4 = Sheet3.Range("r10:t14")
Set Rng5 = Sheet3.Range("v10:x16")
Set Rng6 = Sheet3.Range("z10:ab14")
Set Sample = Union(Rng1, Rng2, Rng3, Rng3, Rng4, Rng5, Rng5, Rng6)
Set Dict = CreateObject("Scripting.Dictionary")
'=====================================================
For a = 1 To Sample.Areas.Count
    With Sample.Areas(a)
        For i = 1 To Sample.Areas(a).Rows.Count
            sKey = Sample.Areas(a).Cells(i, 2).Value
            Dict.Add sKey, Array(Sample.Areas(a).Cells(i, 3))
        Next i
    End With
Next a
'Để ra được đoạn này thật không dễ chút nào. Tưởng ít nhưng đọc thấy mồ
'======================================================
Set SData = Sheet1.Range("b10:d38")
DataRows = SData.Rows.Count
ReDim RArr(1 To DataRows, 1 To 1)
For i = 1 To DataRows
    sKey = SData.Cells(i, 2).Value
    If Dict.exists(sKey) Then
        RArr(i, 1) = Dict.Item(sKey)(0)
    End If
Next
Sheet1.Range("d10").Resize(UBound(RArr, 1), 1).Value = RArr
End Sub
Sáng sớm nhận được 2 bài #23 và bài #24 của chú Mỹ và bác @batman1. Kế từ lúc "thả tim" đến giờ mới làm cho code nó chạy được nên mới có bài để trả. Cũng là cách cảm ơn sự chỉ dạy và mong cầu sự chỉ dạy của các chú các bác.
Bài #26 của chú Mỹ, chú đã mất công sức nhiều quá. Cháu cảm ơn chú đã hết lòng như vậy! Phần Array kiến thức thì cao cấp, còn Dictionary những gì thấy vướng cháu đã cơ bản. Giờ có bài mới cháu sẽ học sang Array và nghiền lại bài #26 vào một buổi khác.
Cảm ơn Chú Mỹ, Bác @batman1, cảm ơn tất cả thật nhiều!
 
Lần chỉnh sửa cuối:
Upvote 0
Code cách 3, bài 17: Dùng 1 Sub và không phát sinh cột phụ giải bằng Dictionary, dựa theo hướng dẫn của bác @batman1 ở bài #24
PHP:
            Dict.Add sKey, Array(Sample.Areas(a).Cells(i, 3)) '(1)'
Sao vẫn cứ sử dụng Array cho mỗi 1 phần tử vậy?
Và dữ liệu không trùng thì đâu có cần dùng Dict? Nếu dùng Dict thì phải điều kiện Exist như bài mắng 23 chứ
Thử lấy code này chạy cho file ở bài 26 xem
 
Upvote 0
Sao vẫn cứ sử dụng Array cho mỗi 1 phần tử vậy?
Và dữ liệu không trùng thì đâu có cần dùng Dict? Nếu dùng Dict thì phải điều kiện Exist như bài mắng 23 chứ
Thử lấy code này chạy cho file ở bài 26 xem
Bài #17 cháu cố tình lập dữ liệu để sử dụng Dictionary và tất cả vướng mắc bài #17 đã được xử lý được với bài # 24 của bác @batman1
Bài #26 vẫn là Dict nhưng cơ bản muốn làm được lại là Array. Nên tất cả giờ phải là Array(nhìn Array cháu thấy nó cứ cao cấp thế này í), cháu lại hành chú mất thôi.
 
Upvote 0
Set Sample = Union(Rng1, Rng2, Rng3, Rng3, Rng4, Rng5, Rng5, Rng6)
Ôm một mớ vào nên càng rắc rối, khó hiểu, khó làm.

Thay vì tiếp cận theo cách đó thì mình đi học lý thuyết đã.
1/ Tầm vực biến
2/ Cách tạo và dùng Sub-Function con, ByVal/ ByRef...

Rồi bài trên viết một Sub/Function con áp dụng cho 1 Range ngon lành. Sau đó chỉ cần gọi nó cho danh sách Range(s) là được.
 
Upvote 0
Code cách 3, bài 17: Dùng 1 Sub và không phát sinh cột phụ giải bằng Dictionary, dựa theo hướng dẫn của bác @batman1 ở bài #24
PHP:
Set Rng1 = Sheet3.Range("F10:H12")
Set Rng2 = Sheet3.Range("j10:l14")
Set Rng3 = Sheet3.Range("n10:p13")
Set Rng4 = Sheet3.Range("r10:t14")
Set Rng5 = Sheet3.Range("v10:x16")
Set Rng6 = Sheet3.Range("z10:ab14")
Set Sample = Union(Rng1, Rng2, Rng3, Rng3, Rng4, Rng5, Rng5, Rng6)
Nếu các vùng là hằng số như vầy thì người ta không viết như vậy. Mà chỉ cần viết 1 dòng
Mã:
Set Sample = Sheet3.Range("F10:H12,j10:l14,n10:p13,r10:t14,v10:x16,z10:ab14")
Nếu không nắm vững những kiến thức cơ bản có thể bạn sẽ phải viết hàng chục dòng code để xử lý vấn đề mà lẽ ra chỉ viết 2, 3 dòng là xong.
 
Upvote 0
Nếu các vùng là hằng số như vầy thì người ta không viết như vậy. Mà chỉ cần viết 1 dòng
Mã:
Set Sample = Sheet3.Range("F10:H12,j10:l14,n10:p13,r10:t14,v10:x16,z10:ab14")
Nếu không nắm vững những kiến thức cơ bản có thể bạn sẽ phải viết hàng chục dòng code để xử lý vấn đề mà lẽ ra chỉ viết 2, 3 dòng là xong.
ôi vậy ạ. hay quá! Cảm ơn bác đã chỉ cho ạ!
hoặc các biểu thức:
n = n1 + n2
m = m1 + m2
thì thành:
n = n1 + n2: m = m1 + m2
Cùng 1 dòng phải không ạ
Bài đã được tự động gộp:

Ôm một mớ vào nên càng rắc rối, khó hiểu, khó làm.
Thay vì tiếp cận theo cách đó thì mình đi học lý thuyết đã.
1/ Tầm vực biến
2/ Cách tạo và dùng Sub-Function con, ByVal/ ByRef...
Rồi bài trên viết một Sub/Function con áp dụng cho 1 Range ngon lành. Sau đó chỉ cần gọi nó cho danh sách Range(s) là được.
Do nóng vội muốn giải quyết xong chỗ còn vướng của Dictionary cháu gặp phải. Nên còn thiếu nhiều lắm ạ!
Cháu thây dễ nhớ và thấm hơn.Nếu học bài cụ thể. Sau đó vướng đến đâu bù lý thuyết đến đấy. Hơi trái khoái vây, nhưng lượm được nhiều lắm bác ạ. Đọc đến đâu nhớ luôn đến đấy!
Cụ thể như bài #24 của bác @batman1 thì rất dễ học và ứng dụng được luôn phải không ạ!
Mong bác giúp cho cháu ít vốn trong quá trình học VBA ạ. Cảm ơn bác nhiều ạ!
 
Lần chỉnh sửa cuối:
Upvote 0
Code cách 3, bài 17: Dùng 1 Sub và không phát sinh cột phụ giải bằng Dictionary, dựa theo hướng dẫn của bác @batman1 ở bài #24
Tôi không bàn về thuật toán, vì mỗi vấn đề có thể giải quyết theo nhiều cách khác nhau. Tôi chỉ bàn về cú pháp.

Bạn có
Mã:
For a = 1 To Sample.Areas.Count
    With Sample.Areas(a)
        For i = 1 To Sample.Areas(a).Rows.Count
            sKey = Sample.Areas(a).Cells(i, 2).Value
            Dict.Add sKey, Array(Sample.Areas(a).Cells(i, 3))
        Next i
    End With
Next a

Hoặc là bạn dùng WITH
Mã:
For a = 1 To Sample.Areas.Count
    With Sample.Areas(a)
        For i = 1 To .Rows.Count
            sKey = .Cells(i, 2).Value
            Dict.Add sKey, .Cells(i, 3).Value
        Next i
    End With
Next a

hoặc không dùng WITH
Mã:
For a = 1 To Sample.Areas.Count
        For i = 1 To Sample.Areas(a).Rows.Count
            sKey = Sample.Areas(a).Cells(i, 2).Value
            Dict.Add sKey, Sample.Areas(a).Cells(i, 3).Value
        Next i
Next a

chứ không ai viết như bạn.

Ngoài ra bạn nên thêm vào từ điển 1 GIÁ TRỊ với tư cách ITEM chứ sao lại thêm 1 MẢNG với chỉ 1 GIÁ TRỊ với tư cách ITEM? Tại sao lại làm phức tạp vấn đề vậy?
 
Upvote 0
Tôi không bàn về thuật toán, vì mỗi vấn đề có thể giải quyết theo nhiều cách khác nhau. Tôi chỉ bàn về cú pháp.

Bạn có
Mã:
For a = 1 To Sample.Areas.Count
    With Sample.Areas(a)
        For i = 1 To Sample.Areas(a).Rows.Count
            sKey = Sample.Areas(a).Cells(i, 2).Value
            Dict.Add sKey, Array(Sample.Areas(a).Cells(i, 3))
        Next i
    End With
Next a

Hoặc là bạn dùng WITH
Mã:
For a = 1 To Sample.Areas.Count
    With Sample.Areas(a)
        For i = 1 To .Rows.Count
            sKey = .Cells(i, 2).Value
            Dict.Add sKey, .Cells(i, 3).Value
        Next i
    End With
Next a

hoặc không dùng WITH
Mã:
For a = 1 To Sample.Areas.Count
        For i = 1 To Sample.Areas(a).Rows.Count
            sKey = Sample.Areas(a).Cells(i, 2).Value
            Dict.Add sKey, Sample.Areas(a).Cells(i, 3).Value
        Next i
Next a

chứ không ai viết như bạn.

Ngoài ra bạn nên thêm vào từ điển 1 GIÁ TRỊ với tư cách ITEM chứ sao lại thêm 1 MẢNG với chỉ 1 GIÁ TRỊ với tư cách ITEM? Tại sao lại làm phức tạp vấn đề vậy?
- With và End With là "xét bởi", xét bởi cái cái gì đó thì trong cái đang xét thì viết tắt đc, cháu hiểu nôm na là vậy.
- gán item là mảng 1 giá trị. Do trên cháu dùng code cũ đang xét 1 bảng để sửa lại cho nhanh.Thấy bỏ mảng lại lỗi. Để mảng lại chạy được. Hoặc có đến 2 lỗi lúc đó nên bỏ Array đi thấy lỗi lại hiểu nó là lỗi do không để giá trị là Array.
Đọc và thử đi thử lại nên đầu óc lu bu quá. Làm theo hướng dẫn bài #24 của bác mong cho code nó chạy được là đc.
Sau cháu chỉnh chu hơn ạ. Cháu cảm ơn bác!
 
Lần chỉnh sửa cuối:
Upvote 0
- Do bài #17 cháu cố tình tạo ra dữ liệu để dùng Dictionary,
- Bài #26 dùng Dictonary để giải nhưng muốn giải được lại là Array.
Cháu nghiền lại bài #26 ạ!
- Cố tình tạo thì phải có trùng, thì Dict mới thấy tác dụng loại trùng chứ?
- Ai bảo muốn giải lại là Array? Muốn các khối dữ liệu là Range vẫn được chứ? Chỉ có Array(6, 10, 14, 18, 22, 26) là mảng thôi.
PHP:
    For col = 0 To 5
        DataRw = .Cells(1000, ColumnArr(col)).End(xlUp).Row
        Set DataStore = .Range(.Cells(10, ColumnArr(col)), _
        .Cells(DataRw, ColumnArr(col))).Resize(, 3)
        For i = 1 To DataStore.Rows.Count
            sKey = DataStore(i, 1)
            If Not Dict.exists(sKey) Then
                Dict.Add sKey, DataStore(i, 3)
            Else
                Dict.Item(sKey) = Dict.Item(sKey) + DataStore(i, 3)
            End If
        Next
    Next
Nghiền lại bài 26 thì tải lại file, lúc trưa mảng ColumnArr sai 2 số cuối
 
Upvote 0
- With và End With là "xét bởi", xét bởi cái cái gì đó thì trong cái đang xét thì viết tắt đc, cháu hiểu nôm na là vậy.
- gán item là mảng 1 giá trị. Do trên cháu dùng code cũ đang xét 1 bảng để sửa lại cho nhanh.Thấy bỏ mảng lại lỗi. Để mảng lại chạy được. Hoặc có đến 2 lỗi lúc đó nên bỏ Array đi thấy lỗi lại hiểu nó là lỗi do không để giá trị là Array.
Đọc và thử đi thử lại nên đầu óc lu bu quá. Làm theo hướng dẫn bài #24 của bác mong cho code nó chạy được là đc.
Sau cháu chỉnh chu hơn ạ. Cháu cảm ơn bác!
Nếu là mình thấy lỗi mình sẽ tìm hiểu đó là lỗi gì học vậy mới mau tiến bộ. Chứ hỏi cú pháp thì học căn bản, lý luận, thuật toán là do bạn đụng nhiêu, làm nhiều thì có nhiều kinh nghiệm thôi.
Theo mình nghĩ là vậy, còn đối với mình vba mình chẳng biết ất giáp gì đâu nha kkmm
 
Upvote 0
Nghiền lại bài 26 thì tải lại file, lúc trưa mảng ColumnArr sai 2 số cuối
Dạ. Array và Dictionary thấy như hình với bóng ấy chú ạ. Trc giờ toàn bắt chiếc chứ thực ra "tròn mắt" là chính hihi. Dồn cho anh Arr này nữa mới khá lên được ạ.
Nếu là mình thấy lỗi mình sẽ tìm hiểu đó là lỗi gì học vậy mới mau tiến bộ. Chứ hỏi cú pháp thì học căn bản, lý luận, thuật toán là do bạn đụng nhiêu, làm nhiều thì có nhiều kinh nghiệm thôi.
Theo mình nghĩ là vậy, còn đối với mình vba mình chẳng biết ất giáp gì đâu nha kkmm
Vâng. Nhưng em toàn chết cái cú pháp lỗi từ đó. Khó diễn tả thành lời, nôm na là như là bài #24 của bác @batman1 ấy, nghĩ mà không nói phát ra tiếng đc ấy. Chỉ nhiêu đó mà mất mờ chân chậm. Em hay chết kiểu như thế. Những cái như vậy không thể tìm cơ bản mà có được.
Chắc anh làm vùng ở GPE lâu rồi.
 
Lần chỉnh sửa cuối:
Upvote 0
Dạ.

Vâng. Nhưng em toàn chết cái cú pháp lỗi từ đó. Khó diễn tả thành lời, nôm na là như là bài #24 của bác @batman1 ấy, nghĩ mà không nói phát ra tiếng đc ấy. Chỉ nhiêu đó mà mất mờ chân chậm. Em hay chết kiểu như thế. Những cái như vậy không thể tìm cơ bản mà có được.
Chắc anh làm vùng ở GPE lâu rồi. Nick mới thôi phải không ạ?
Nếu vậy theo tôi nghĩ bạn chưa nắm những cái cơ bản. Tôi thì mới tham gia DĐ cũng chẳng biết nhiều vba nhưng đọc bài cũng lờ mờ hiểu chúc ít. Trong đây tôi thấy nhiều ngưởi giỏi quá nên bạn theo từ từ thôi, tôi cũng đang học đây
 
Upvote 0
Trong đây tôi thấy nhiều ngưởi giỏi quá nên bạn theo từ từ thôi, tôi cũng đang học đây
Hiện em chưa có cách nào học cơ bản để dễ nhớ cả, quy ra bài tập dạng như kiểu gặp núi xẻ núi, gặp sông thì ngăn sông mà gặp rừng thì... hihi. Vậy ở đây chỗ nào mà "không nói nên lời" thì post vào đây cho nó vui. Bác đúng là người làm cho người khác bớt say, ở đây post bài với em nhé.
 
Lần chỉnh sửa cuối:
Upvote 0
Hiện em chưa có cách nào học cơ bản để nhớ cả, quy ra bài tập dạng như kiểu gặp núi xẻ núi mà gặp rừng thì... hihi. Vậy ở đây chỗ nào mà "không nói nên lời" thì post vào đây cho nó vui. Bác đúng là người làm cho người khác bớt say, ở đây post bài với em nhé.
Kkk tôi cũng muốn cày ít điểm nhưng dạo quanh diễn đàng thấy nhiều thứ mới mẻ quá, cám ơn bạn tôi vẫn theo dõi top của bạn để học đây
 
Upvote 0
Nhưng anh phải cùng ăn roi nữa chớ...post bài về array nhé.
Để mai tôi tập post bài hỏi về việc lọc duy nhất trên nhiều sheet va không trùng cấu trúc bảng có thể được không. Tôi cũng đang nhức đầu tìm chưa ra hichic, chứ lập trình tôi có biết chi mô
 
Upvote 0
Để mai tôi tập post bài hỏi về việc lọc duy nhất trên nhiều sheet va không trùng cấu trúc bảng có thể được không. Tôi cũng đang nhức đầu tìm chưa ra hichic
Làm 1 Sub bắt nó phải trùng cấu trúc, hoặc lọc lần lượt ra 1 sheets, rồi dùng Dict táng nó tiếp , xử lý trên sheets " ảo" xong việc auto xóa nó đi. Kiểu này anh post vào đây nó đúng chỗ.
 
Lần chỉnh sửa cuối:
Upvote 0
Làm 1 Sub bắt nó phải trùng cấu trúc, hoặc lọc lần lượt ra 1 sheets, rồi dùng Dict táng nó tiếp , xử lý trên sheets " ảo" xong việc auto xóa nó đi. Kiểu này anh post vào đây nó đúng chỗ.
Không cần, cứ dùng code bài 26 phăng ra thêm
 
Upvote 0
Upvote 0
Cũng không có gì đặt trưng, mình có 4 sheet mỗi sheet điều có 2 cột mã đơn và mã hàng tuy nhiên 2 cột này nó không nằm cố định ví dụ sheet 1 mã đơn nằm cột A và mã hàng cột B, sheet 2 mã đơn nằm cột D và mã hàng cột G. Mình chỉ muốn tổng hợp (mã đơn) & (mã hàng) có duy nhất trên 4 sheet gộp lại.
Máy Công ty không có nối mạng ra ngoài bạn nên mình toàn dùng điện thoại không
 
Upvote 0
Cũng không có gì đặt trưng, mình có 4 sheet mỗi sheet điều có 2 cột mã đơn và mã hàng tuy nhiên 2 cột này nó không nằm cố định ví dụ sheet 1 mã đơn nằm cột A và mã hàng cột B, sheet 2 mã đơn nằm cột D và mã hàng cột G. Mình chỉ muốn tổng hợp (mã đơn) & (mã hàng) có duy nhất trên 4 sheet gộp lại.
Máy Công ty không có nối mạng ra ngoài bạn nên mình toàn dùng điện thoại không
Nếu dùng Dictionary, hiện khá đã đủ chất liệu để chế cháo rồi đó.
 
Upvote 0
Cách 4:
- Toàn bộ dùng mảng
Bước 1: Do dữ liệu trên cùng sheet nên tạo 1 mảng là các cột đầu của các bảng dữ liệu: ColumnArr = Array(6, 10, 14, 18, 24, 30)
Bước 2: Dùng vòng lặp 6 vòng, mỗi vòng:
- Lấy dữ liệu 1 khối vào mảng
- Duyệt dữ liệu mảng, add vào Dict, tính SL bán (dữ liệu mới cho chuẩn, không làm dữ liệu và báo cáo ngu ngơ)
Bước 3:
Duyệt dữ liệu cột B: mặt hàng nào có bán thì điền tổng số lượng bán
Với cách 4 ở bài #26. Chú thương trò không tiếc công, đã cho 1 ví dụ và đặc sắc nhất của Dictionary đó là lọc trùng và cộng dồn.
Ở đây cháu lấy cách duyệt các bảng(6 bảng) của bài #24 tương tự như cách 3 theo hướng dẫn của bác @batman1 để có cách 4 của riêng bài #17 ( bài #17 là lấy tên thầy làm Key tên môn dạy là Item, bài #26 lấy mã hàng làm Key và lấy giá trị để cộng dồn là Item). Để trả bài và các bạn nào mới học VBA cũng có mà mày mò, và có cách 4 với bài #17(tên biến hơi ngồ ngộ do copy để sửa chứ chưa chỉnh chu) như sau:
PHP:
Sub DictExercise_trabaitap()
Dim MaxRw As Long, DataRw As Long, i As Long
Dim DataStore(), ColumnArr, sKey As String, SData As Range
Dim Dict, RArr()
Set Dict = CreateObject("Scripting.Dictionary")
ColumnArr = Array(6, 10, 14, 18, 22, 26)
With Sheets("cach3")
'==========================================
    For col = 0 To 5
        DataRw = .Cells(1000, ColumnArr(col)).End(xlUp).Row
        DataStore = .Range(.Cells(10, ColumnArr(col)), _
        .Cells(DataRw, ColumnArr(col))).Resize(, 3).Value
        For i = 1 To UBound(DataStore, 1)
            sKey = DataStore(i, 2)
            Dict.Add sKey, Array(DataStore(i, 3))
        Next
    Next
'Phần này là tương đương với cách duyệt theo hướng dẫn bài #24
'==========================================
Set SData = .Range("b10:d38")
DataRows = SData.Rows.Count
ReDim RArr(1 To DataRows, 1 To 1)
    For i = 1 To DataRows
        sKey = SData(i, 2)
        If Dict.exists(sKey) Then
        RArr(i, 1) = Dict.Item(sKey)(0)
    End If
    Next
.Range("d10").Resize(UBound(RArr, 1), 1).Value = RArr
End With
End Sub
Bài đã được tự động gộp:

Hết làm em gái mưa rồi à?
em gái mưa còn kém duyên quá nên giờ bày hết duyên ra ngoài luôn ạ :p
 
Lần chỉnh sửa cuối:
Upvote 0
Với cách 4 ở bài #26. Chú thương trò không tiếc công, đã cho 1 ví dụ và đặc sắc nhất của Dictionary đó là lọc trùng và cộng dồn.

'Phần này là tương đương với cách duyệt theo hướng dẫn bài #24
...
Chả có cái gì giống với bài 24. Bài 24 là cách sử dụng Union và xử lý Union. Ngoài ra, item chỉ 1 giá trị đơn cũng nhét vào mảng.
batman1 bài 33 đã viết:
Ngoài ra bạn nên thêm vào từ điển 1 GIÁ TRỊ với tư cách ITEM chứ sao lại thêm 1 MẢNG với chỉ 1 GIÁ TRỊ với tư cách ITEM? Tại sao lại làm phức tạp vấn đề vậy?
ptm bài 28 đã viết:
Sao vẫn cứ sử dụng Array cho mỗi 1 phần tử vậy?
Xem ra phải tưới nước sôi chứ không tưới hương hoa gì cả.
 
Upvote 0
Chả có cái gì giống với bài 24. Bài 24 là cách sử dụng Union và xử lý Union. Ngoài ra, item chỉ 1 giá trị đơn cũng nhét vào mảng.


Xem ra phải tưới nước sôi chứ không tưới hương hoa gì cả.
Hic cháu không ăn quen mì gói. Do tranh thủ có bài nên cứ chế vào nó chạy đc là úp ngay lên gpe.
Vài hôm nữa ngâm thêm về Array cháu sửa lại hết ạ.
 
Upvote 0
Lấy file và code bài 26, quăng lung tung dữ liệu 6 cửa hàng vào 6 sheet và chế đi nào

Quăng lung tung tức là quăng không cố định cột A hay B gì hết, mỗi sheet 1 cột khác nhau
 
Upvote 0
Lấy file và code bài 26, quăng lung tung dữ liệu 6 cửa hàng vào 6 sheet và chế đi nào

Quăng lung tung tức là quăng không cố định cột A hay B gì hết, mỗi sheet 1 cột khác nhau
Vâng ạ. Chắc sẽ sinh thêm cú pháp (nôm na như bài #24), cũng trường hợp duyệt nhiều bảng nhưng khác cái là mỗi bảng ở 1 Sheet. Giống bài anh @Phụ Hồ Lên Phú Hộ đang kêu đau đầu. Cháu thử xem sao có làm đươc không.
 
Lần chỉnh sửa cuối:
Upvote 0
Hình như mọi người đi sai chủ đề (có thể nhầm chăng, hay người hỏi nhầm)
Vì thấy chủ đề nói thuật toán, mà trong các bài viết toàn thấy code và lời minh họa giải thích, đâu có thấy nói chi thuật toán nào đâu.
 
Lần chỉnh sửa cuối:
Upvote 0
Hết làm em gái mưa rồi à?
Bây giờ muốn làm "Cô bé dễ thương" anh ạ. Chứ kiểu em gái mưa, em gái nuôi, em gái kết nghĩa thì hay bị ném đá lắm.
Mà ở Việt Nam cũng lạ. Nhưng tôi luôn thấy em gái mưa, em gái nuôi, em gái kết nghĩa chỉ là chuyện tào lao. Mà cái gì "nuôi" thì rồi cũng sẽ "thịt". Bầy đặt.
 
Upvote 0
Hình như mọi người đi sai chủ đề (có thể nhầm chăng, hay người hỏi nhầm)
Vì thấy chủ đề nói thuaạt toán, mà trong các bài viết toàn thấy code và lời minh họa giải thích, đâu có thấy nói chi thuật toán nào đâu.

Người mới học VBA, gặp khó khăn: Cú pháp, lý luận, thuật toán trong VBA thì vào đây cùng học!​

Có chứ bác, chưa đủ nhiều bài để phản ánh hết thôi! Em chủ quan suy từ em ra, muốn nói cho VBA nó hiểu câu "tôi có 5 bảng vba hãy duyệt 5 bảng dữ liệu cho tôi" để vba nó hiểu câu này thì là một kho kiến thức. Nhưng với bài #24 và #26 thì nói vba nó hiểu ngay. Người mới học gặp thớt này dễ học lắm chứ bác. Mong được bác chia sẻ thêm giúp cho việc học vba đỡ vất vả!
Bây giờ muốn làm "Cô bé dễ thương" anh ạ. Chứ kiểu em gái mưa, em gái nuôi, em gái kết nghĩa thì hay bị ném đá lắm.
Mà ở Việt Nam cũng lạ. Nhưng tôi luôn thấy em gái mưa, em gái nuôi, em gái kết nghĩa chỉ là chuyện tào lao. Mà cái gì "nuôi" thì rồi cũng sẽ "thịt". Bầy đặt.
Vâng! "Bố Đường" thịt thật ấy bác ạ.
Kém duyên quá! Nên cháu đổi biết đâu được nhiều thầy chỉ cho hơn!
 
Lần chỉnh sửa cuối:
Upvote 0
Còn cháu để tên cũ thấy không hợp phong thủy và kém duyên quá! Nên đổi biết đâu được nhiều thầy chỉ cho hơn!
Phong thuỷ cũng là tào lao. Vô duyên thì nói thẳng là vô duyên, chứ kém gì. (Đọc trên mạng đầy, phát chán)
File dưới đây là đã quăng lung tung 6 sheet. Hiện tại là cùng bắt đầu dòng 4 chỉ khác cột, nếu khác dòng cũng vẫn được.
 

File đính kèm

Upvote 0
Vô duyên thì nói thẳng là vô duyên, chứ kém gì. (Đọc trên mạng đầy, phát chán)
File dưới đây là đã quăng lung tung 6 sheet. Hiện tại là cùng bắt đầu dòng 4 chỉ khác cột, nếu khác dòng cũng vẫn được.
Nhưng mất code rồi chú ơi.
 
Upvote 0
bài của mình nó không có nằm 3 cột liền nhau như vậy đâu, có sheet có mã - họ - tên - số lượng bán, có sheet có mã - họ - tên đệm - tên - đơn vị tính - số lượng bán, có sheet có số lượng bán họ - tên - mã - đệm - tên
nếu theo như vi dụ đó thì chắc làm AdvanFileter ra sheet tmp cũng được khỏi cần dic
 
Upvote 0
bài của mình nó không có nằm 3 cột liền nhau như vậy đâu, có sheet có mã - họ - tên - số lượng bán, có sheet có mã - họ - tên đệm - tên - đơn vị tính - số lượng bán, có sheet có số lượng bán họ - tên - mã - đệm - tên
nếu theo như vi dụ đó thì chắc làm AdvanFileter ra sheet tmp cũng được khỏi cần dic
Code bài 26 chế lại chạy được hết
 
Upvote 0
Không phải mất mà là bị cố tình xoá. Tự viết code mới gọi là bài tập, ở đâu có sẵn mãi?
Cháu làm theo dạng: các bảng khác Sheets không trùng chỉ số dòng và cột của ô bắt đầu, dòng bắt đầu dữ liệu của bảng.Loay hoay từ chiều đến giờ không chạy được code chú ạ!
- Thêm 1 mảng RowArr = Array(4, 9, 17, 21, 4, 18)
- Thêm 2 vòng For để duyệt sheet và duyệt chỉ số ô bắt đầu dữ liệu của bảng
Khả năng duyệt sai cú pháp phải không chú?
PHP:
Sub DictExercise5()
Dim MaxRw As Long, DataRw As Long, i As Long
Dim ColumnArr, sKey As String, RowArr
Dim Dict, SArr(), RArr()
Set Dict = CreateObject("Scripting.Dictionary")
ColumnArr = Array(2, 3, 1, 4, 18, 2)
RowArr = Array(4, 9, 17, 21, 4, 18)
For b = 2 To ThisWorkbook.Worksheets.Count
    For col = 0 To 5
        For dong = 0 To 5
            DataRw = ThisWorkbook.Worksheets(b).Cells(1000, ColumnArr(col)).End(xlUp).Row
            DataStore = ThisWorkbook.Worksheets(b).Range(ThisWorkbook.Worksheets(b).Cells(RowArr(dong), ColumnArr(col)), _
            ThisWorkbook.Worksheets(b).Cells(DataRw, ColumnArr(col))).Resize(, 3).Value
            For i = 1 To UBound(DataStore, 1)
                sKey = DataStore(i, 1)
                If Not Dict.exists(sKey) Then
                    Dict.Add sKey, DataStore(i, 3)
                Else
                    [COLOR=rgb(209, 72, 65)]Dict.Item(sKey) = Dict.Item(sKey) + DataStore(i, 3) 'dòng này báo lỗi: Type mismatch[/COLOR]
                End If
            Next i
        Next dong
    Next col
Next b
    SArr = Sheets("Episode5").Range(Cells(10, 2), Cells(1000, 2).End(xlUp)).Value
    ReDim RArr(1 To UBound(SArr, 1), 1 To 1)
    For i = 1 To UBound(SArr, 1)
        If Dict.exists(SArr(i, 1)) Then
            RArr(i, 1) = Dict.Item(SArr(i, 1))
        Else
            RArr(i, 1) = 0
        End If
    Next
    Sheets("Episode5").Range("D10:D1000").ClearContents
    Sheets("Episode5").Range("D10").Resize(UBound(SArr, 1), 1) = RArr
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Cháu làm theo dạng: các bảng khác Sheets không trùng chỉ số dòng và cột của ô bắt đầu, dòng bắt đầu dữ liệu của bảng.Loay hoay từ chiều đến giờ không chạy được code chú ạ!
- Thêm 1 mảng RowArr = Array(4, 9, 17, 21, 4, 18)
- Thêm 2 vòng For để duyệt sheet và duyệt chỉ số ô bắt đầu dữ liệu của bảng
Khả năng duyệt sai cú pháp phải không chú?
PHP:
Sub DictExercise5()
Dim MaxRw As Long, DataRw As Long, i As Long
Dim ColumnArr, sKey As String, RowArr
Dim Dict, SArr(), RArr()
Set Dict = CreateObject("Scripting.Dictionary")
ColumnArr = Array(2, 3, 1, 4, 18, 2)
RowArr = Array(4, 9, 17, 21, 4, 18)
For b = 2 To ThisWorkbook.Worksheets.Count
    For col = 0 To 5
        For dong = 0 To 5
            DataRw = ThisWorkbook.Worksheets(b).Cells(1000, ColumnArr(col)).End(xlUp).Row
            DataStore = ThisWorkbook.Worksheets(b).Range(ThisWorkbook.Worksheets(b).Cells(RowArr(dong), ColumnArr(col)), _
            ThisWorkbook.Worksheets(b).Cells(DataRw, ColumnArr(col))).Resize(, 3).Value
            For i = 1 To UBound(DataStore, 1)
                sKey = DataStore(i, 1)
                If Not Dict.exists(sKey) Then
                    Dict.Add sKey, DataStore(i, 3)
                Else
                    Dict.Item(sKey) = Dict.Item(sKey) + DataStore(i, 3) 'dòng này báo lỗi: Type mismatch
                End If
            Next i
        Next dong
    Next col
Next b
    SArr = Sheets("Episode5").Range(Cells(10, 2), Cells(1000, 2).End(xlUp)).Value
    ReDim RArr(1 To UBound(SArr, 1), 1 To 1)
    For i = 1 To UBound(SArr, 1)
        If Dict.exists(SArr(i, 1)) Then
            RArr(i, 1) = Dict.Item(SArr(i, 1))
        Else
            RArr(i, 1) = 0
        End If
    Next
    Sheets("Episode5").Range("D10:D1000").ClearContents
    Sheets("Episode5").Range("D10").Resize(UBound(SArr, 1), 1) = RArr
End Sub
Bạn đọc lại cú pháp câu lệnh, Đọc căn bản cho hiểu rồi vọc mấy cái đó, làm vậy hiểu được chỗ này mất hết chỗ kia đó.
 
Upvote 0
Cháu làm theo dạng: các bảng khác Sheets không trùng chỉ số dòng và cột của ô bắt đầu, dòng bắt đầu dữ liệu của bảng.Loay hoay từ chiều đến giờ không chạy được code chú ạ!
- Thêm 1 mảng RowArr = Array(4, 9, 17, 21, 4, 18)

Mã:
For b = 2 To ThisWorkbook.Worksheets.Count
    For col = 0 To 5
        For dong = 0 To 5
Thêm 1 mảng SheetArr = Array("CH1", "CH2", ...)
Chỉ cần 1 vòng lặp
Mã:
for Sequence = 0 to 5
   with Sheets(SheetArr(Sequence))
      .DataRw = ...
      DataStore = ...
      For i = 1 To UBound(DataStore, 1)
            ...
 
Upvote 0
bài của mình nó không có nằm 3 cột liền nhau như vậy đâu, có sheet có mã - họ - tên - số lượng bán, có sheet có mã - họ - tên đệm - tên - đơn vị tính - số lượng bán, có sheet có số lượng bán họ - tên - mã - đệm - tên
nếu theo như vi dụ đó thì chắc làm AdvanFileter ra sheet tmp cũng được khỏi cần dic
Bạn đọc lại cú pháp câu lệnh, Đọc căn bản cho hiểu rồi vọc mấy cái đó, làm vậy hiểu được chỗ này mất hết chỗ kia đó.
Do vẫn cần Dict giải quyết bài có các bảng ở các Sheets khác nhau. Có lễ đây là trường hợp cuối cùng Dict cần xử lý.
Chứ làm cho ra kết quả tốn nhiều Sub và làm nặng thêm file vẫn sử lý được phải không bạn?
Bài đã được tự động gộp:

Thêm 1 mảng SheetArr = Array("CH1", "CH2", ...)
Chỉ cần 1 vòng lặp
Mã:
for Sequence = 0 to 5
   with Sheets(SheetArr(Sequence))
      .DataRw = ...
      DataStore = ...
      For i = 1 To UBound(DataStore, 1)
            ...
Trường hợp file cháu đính kèm bài #63 là có dòng và cột quang lung tung, vậy thì phải có vòng duyệt chỉ số dòng có ô bắt đầu dữ liệu nữa phải không ạ?
 
Upvote 0
Do vẫn cần Dict giải quyết bài có các bảng ở các Sheets khác nhau. Có lễ đây là trường hợp cuối cùng Dict cần xử lý.
Chứ làm cho ra kết quả tốn nhiều Sub và làm nặng thêm file vẫn sử lý được phải không bạn?
Bài đã được tự động gộp:


Trường hợp file cháu đính kèm bài #63 là có dòng và cột quang lung tung, vậy thì phải có vòng duyệt chỉ số dòng có ô bắt đầu dữ liệu nữa phải không ạ?
Mình đưa ra lời góp ý chân thành vậy thôi. Mong bạn hiểu. Cứ căn bản mà học, Học tốt rồi lên cao đâu có muộn bạn à.
Đôi lúc cần cái đơn giản có thể giải quyết vấn đề rồi. Giống như Thầy @ptm0412 góp ý cho bạn.
 
Upvote 0
Trường hợp file cháu đính kèm bài #63 là có dòng và cột quang lung tung, vậy thì phải có vòng duyệt chỉ số dòng có ô bắt đầu dữ liệu nữa phải không ạ?
Đọc kỹ nhé, tôi nói là "thêm SheetArr" tức là đã có 2, thêm 1 là 3, chứ không phải "chỉ thêm 1 thành 2"
 
Lần chỉnh sửa cuối:
Upvote 0
Đọc kỹ nhé, tôi nói là "thêm SheetArr" tức là đã có 2, thêm 1 là 3, chứ không phải "chỉ thêm 1 thành 2"
Vâng. Sợ nhiều việc quá chú quên í, nên hỏi lại cho chắc ăn ạ! Ngoài thêm mảng RowArr thêm 1 mảng SheetArr nữa.
Bài đã được tự động gộp:

Mình đưa ra lời góp ý chân thành vậy thôi. Mong bạn hiểu. Cứ căn bản mà học, Học tốt rồi lên cao đâu có muộn bạn à.
Đôi lúc cần cái đơn giản có thể giải quyết vấn đề rồi. Giống như Thầy @ptm0412 góp ý cho bạn.
Cảm ơn bạn. Mình hiểu chỗ kẹt này là do thiếu kiến thức cơ bản. Ham đánh cả cụm quá nên phải chày cối, chịu bao búa rìu. Cố nốt bài này thôi rồi làm hàm con Sub/Function ByRef, ByVal
 
Upvote 0
PHP:
    For col = 0 To 5
        For dong = 0 To 5
              ...
                   Dict.Item(sKey) = Dict.Item(sKey) + DataStore(i, 3) 'dòng này báo lỗi: Type mismatch
Mỗi 1 sheet chỉ có 1 ô "đầu tiên chứa dữ liệu", Chạy 2 vòng for lồng nhau té ra mỗi sheet có 5 x 5 là 25 bộ dữ liệu à. 24 bộ thừa kia trùng hợp có chứa dữ liệu text cộng dồn vào item nên bị Type Mismatch
 
Upvote 0
Mỗi 1 sheet chỉ có 1 ô "đầu tiên chứa dữ liệu", Chạy 2 vòng for lồng nhau té ra mỗi sheet có 5 x 5 là 25 bộ dữ liệu à. 24 bộ thừa kia trùng hợp có chứa dữ liệu text cộng dồn vào item nên bị Type Mismatch
Vâng ạ! do chưa tạo ra và chọn đúng vùng để tạo Key nên bị lỗi ạ. Nhưng cháu vẫn chưa nghĩ ra được nếu không có thêm 1 vòng để gán chỉ số dòng ô đầu tiên bắt đầu dữ liệu bảng(bảng văng lung tung) thì sao mà xác đinh được đoạn thẳng đứng (cột dữ liệu đầu tiên của bảng), nếu không có đoạn thằng đứng này thì không resize ra hình chữ nhật được. Và như vậy chưa duyệt trúng vị trí của bảng dữ liệu( nguyên nhân tạo Key lỗi). Mong chú chỉ cho cháu đoạn này với!
 
Lần chỉnh sửa cuối:
Upvote 0
Vâng ạ! do chưa tạo ra và chọn đúng vùng để tạo Key nên bị lỗi ạ. Nhưng cháu vẫn chưa nghĩ ra được nếu không có thêm 1 vòng để gán chỉ số dòng ô đầu tiên bắt đầu dữ liệu bảng thì sao mà xác đinh được đoạn thẳng đứng (cột dữ liệu đầu tiên của bảng), nếu không có đoạn thằng đứng này thì không resize ra hình chữ nhật được. Và như vậy chưa duyệt trúng vị trí của bảng dữ liệu( nguyên nhân tạo Key lỗi). Mong chú chỉ cho cháu đoạn này với!
Chỉ cần 1 vòng lặp:
1 sheet, 1 cột, 1 dòng là ra ô đầu, cột đó xác định dòng cuối, rồi cột đó resize chứ sao.
Ví dụ Sequence = 0:
Sheets(SheetArr(0)) = sheets("shop1")
RowArr(0) = 4
ColumnArr(0) = 2
Thế là có ô đầu Cells(4, 2)
DataRw = Cells(1000,2).End ...
Ô cuối là Cells(DataRw,2),
Resize 3
__________
Seq = 1
Sheets(SheetArr(1)) = sheets("shop2")
RowArr(1) = 9
ColumnArr(1) = 3
 
Upvote 0
Chỉ cần 1 vòng lặp:
1 sheet, 1 cột, 1 dòng là ra ô đầu, cột đó xác định dòng cuối, rồi cột đó resize chứ sao.
Cháu hoàn thành rồi chú ạ. Cách dùng "For Sequence" nó phải thuộc dự án vba lớn thì mới có. Chứ mò sách nào mà có được ạ! Cảm ơn chú nhiều lắm!
Bài Dict có Bảng văng lung tung.
Chỉ 1 dấu chấm trong code thôi mà chết ngắc đến giờ ạ! Bài học quá quý giá!
PHP:
Dim MaxRw As Long, DataRw As Long, i As Long
Dim ColumnArr, sKey As String, RowArr, SheetArr
Dim Dict, SArr(), RArr()
Set Dict = CreateObject("Scripting.Dictionary")
SheetArr = Array(2, 3, 4, 5, 6, 7)
ColumnArr = Array(2, 3, 1, 4, 18, 2)
RowArr = Array(4, 9, 17, 21, 4, 18)
For Sequence = 0 To 5
   With Sheets(SheetArr(Sequence))
        DataRw = .Cells(1000, ColumnArr(Sequence)).End(xlUp).Row
        ' .Range(.Cells.... the định nghĩa trước chữ Cell không có dấu chấm. mỗi dấu chấm đó mất cả buổi sợ thật
        ' Theo định nghĩa Range(Cells(a,b), Cells(c,d)) mà trong bài lại có cái dấu chấm trước chữ .Cells khổ cái dấu chấm này quá(khóc)
        DataStore = .Range(.Cells(RowArr(Sequence), ColumnArr(Sequence)), _
        .Cells(DataRw, ColumnArr(Sequence))).Resize(, 3).Value  '<--------- chỉ vì dấu chấm trước chữ Cells (.Cells) theo định nghĩa mà không biết lỗi từ đâu.
        For i = 1 To UBound(DataStore, 1)
            sKey = DataStore(i, 1)
            If Not Dict.exists(sKey) Then
                Dict.Add sKey, DataStore(i, 3)
            Else
                Dict.Item(sKey) = Dict.Item(sKey) + DataStore(i, 3)
            End If
        Next i
    End With
Next Sequence
SArr = Sheets("Episode5").Range(Cells(10, 2), Cells(1000, 2).End(xlUp)).Value
ReDim RArr(1 To UBound(SArr, 1), 1 To 1)
For i = 1 To UBound(SArr, 1)
    If Dict.exists(SArr(i, 1)) Then
        RArr(i, 1) = Dict.Item(SArr(i, 1))
    Else
        RArr(i, 1) = 0
    End If
Next
Sheets("Episode5").Range("D10:D1000").ClearContents
Sheets("Episode5").Range("D10").Resize(UBound(SArr, 1), 1) = RArr
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Upvote 0
Khiếp, tỷ năm mới thấy tự làm, tự sai, tự sửa 1 lần. Thưởng cho 1 tim
Tuy làm được đến đây rồi, nhưng vẫn chưa hoàn hồn, cháu vẫn còn 2 câu hỏi nữa:
- Dấu chấm trước chữ Cells trong đoạn code:
PHP:
DataStore = .Range(.Cells(RowArr(Sequence), ColumnArr(Sequence)), _
        .Cells(DataRw, ColumnArr(Sequence))).Resize(, 3).Value
Mà theo định nghĩa lại không có?
- Với lại data các bảng có Key là màu sắc(interior.Color) thì có phải xử lý gì không? Hay chỉ cần gọi nó là Key chuỗi là được ạ?
 
Lần chỉnh sửa cuối:
Upvote 0
Tuy làm được đến đây rồi, nhưng vẫn chưa hoàn hồn, cháu vẫn còn 2 câu hỏi nữa:
- Dấu chấm trước chữ Cells trong đoạn code:

- Với lại data các bảng có Key là màu sắc(interior.Coler) thì có phải xử lý gì không? Hay chỉ cần gọi nó là Key chuỗi là được ạ?
- Định nghĩa không có chấm mút mắm tôm chanh gì cả, và mặc định là sheet hiện hành. Nếu không phải sheet hiện hành thì phải ghi rõ sheets(...).Range(sheets(...).Cels(...), sheets(...).Cells(...))
Nhưng sheets(...) đã viết tắt bằng With - End With nên không cần nhắc lại tỷ lần mà chỉ chấm chấm thôi
- Các bảng key là màu sắc thì không dùng mảng được mà phải dùng range
Set DataStore = Range(......) rồi sKey = nối chuỗi
 
Upvote 0
- Định nghĩa không có chấm mút mắm tôm chanh gì cả, và mặc định là sheet hiện hành. Nếu không phải sheet hiện hành thì phải ghi rõ sheets(...).Range(sheets(...).Cels(...), sheets(...).Cells(...))
Nhưng sheets(...) đã viết tắt bằng With - End With nên không cần nhắc lại tỷ lần mà chỉ chấm chấm thôi
- Các bảng key là màu sắc thì không dùng mảng được mà phải dùng range
Set DataStore = Range(......) rồi sKey = nối chuỗi
Quá bổ ích "For Sequence = 0 To 5", thay thử Sequence = biến, thì lỗi. Vậy Sequence là hàm điền số theo thứ tự à chú (vì nếu để điền số thì theo định nghĩa là khác cơ?)
 
Upvote 0
Quá bổ ích "For Sequence = 0 To 5", thay thử Sequence = biến, thì lỗi. Vậy Sequence là hàm điền số theo thứ tự à chú (vì nếu để điền số thì theo định nghĩa là khác cơ?
Sequence là tên biến được đặt theo ý nghĩa số thứ tự trong các Array từ 0 đến 5, không liên quan đến hàm hiếc gì. Đặt tên khác chả sao, nhưng nên đặt mang ý nghĩa cần diễn tả
 
Upvote 0
Sequence là tên biến được đặt theo ý nghĩa số thứ tự trong các Array từ 0 đến 5, không liên quan đến hàm hiếc gì. Đặt tên khác chả sao, nhưng nên đặt mang ý nghĩa cần diễn tả
Vậy khả năng lúc cháu đổi nó là biến khác vẫn còn lỗi nên hiểu lầm.
Kiểm tra lại vẫn sai: Mã hàng 6 = 0 thì đúng, mà mã hàng 29 = 0 thì sai. Chắc mai mới có thời gian kiểm tra, giờ muộn lắm rồi. Chú đi nghỉ sớm nhé, muộn lắm rồi ạ! --=--
 
Upvote 0

File đính kèm

Upvote 0
Bài mới: Dữ liệu quăng lung tung dòng, cột đồng thời lung tung thứ tự cột theo kiểu bài 61:

View attachment 255374
Cháu chế thêm sẽ chế thêm 1 cửa hàng thứ 7, theo kịch bản CỬA HÀNG 7 chuẩn bị khai trương(không mã, không tên, không số lượng, có mỗi tiêu đề thôi). Lót thêm 1 kịch bản đó vào chắc sẽ hay học được nhiều kiểu xử lý hơn.
 
Lần chỉnh sửa cuối:
Upvote 0
Bài mới: Dữ liệu quăng lung tung dòng, cột đồng thời lung tung thứ tự cột theo kiểu bài 61:

View attachment 255374
Chú gợi ý bài này thêm cho cháu , lỗi và ý muốn làm thì cháu đánh dấu trong code post lên
Quy trình theo cháu nghĩ là:
1. Tạo ra các 4 Array: SheetArr ,ColumnArr ,RowArr, ResizeArr
2. Dòng Vòng lặp For Sequence = 0 To 6 xac dinh duoc hinh chu nhat(chọn đúng vùng dữ liệu của bảng)
3. Cú pháp If-End còn lại để lọc ra các bảng có chứa dữ liệu, rồi chọn đúng cột để tạo Key
4. Có Key rồi gán Item(cộng dồn) xuống sheet
PHP:
Sub Episode6()
Dim DataRw As Long, i As Long
Dim ColumnArr, sKey As String, RowArr, SheetArr, ResizeArr
Dim Dict, SArr(), RArr()
Set Dict = CreateObject("Scripting.Dictionary")
'hic hic thay doi codeName cua Sheet,TY NUA THI MET
'Sheet1 kieu ma cot 1 - sl cot 3
'Sheet2 kieu ma cot 1- sl cot 5
'Sheet4 kieu ma cot 1- sl cot 7
'Sheet5 kieu ma cot 1- sl cot 2
'Sheet6 kieu ma cot 2 - sl cot 1
'Sheet7 kieu ma cot 3 - sl cot 1
'Sheet8 kieu ma cot 1 - sl cot 3, tao ra de xet them truong hop bang khong co du lieu do
ResizeArr = Array(3, 5, 7, 2, 2, 3, 3)
SheetArr = Array(1, 2, 4, 5, 6, 7, 8)
ColumnArr = Array(2, 4, 7, 3, 4, 6, 2)
RowArr = Array(7, 19, 10, 12, 17, 13, 6)
For Sequence = 0 To 6
   With Sheets(SheetArr(Sequence)) 'xac dinh Sheet
   '____________________________________________________________________________
        DataRw = .Cells(1000, ColumnArr(Sequence)).End(xlUp).Row 'vung nay xac dinh doan thang dau tien cua bang, sau do resize thanh hinh chu nhat
        DataStore = .Range(.Cells(RowArr(Sequence), ColumnArr(Sequence)), _
        .Cells(DataRw, ColumnArr(Sequence))).Resize(, ResizeArr(Sequence)).Value
    '____________________________________________________________________________
            If (.Cells(DataRw, ColumnArr(Sequence)).End(xlUp).Row > _
            .Cells(RowArr(Sequence)).End(xlUp).Row And _
            UBound(DataStore, 2) = ResizeArr(Sequence)) Then 'xet dieu kien de loai Cua Hang khong co du lieu va xét xem mảng đó có đúng kích thước hình chữ nhật đang xét hay không
    '____________________________________________________________________________
                For i = 1 To UBound(DataStore, 1)
                    If IsNumeric(.Cells(DataRw, ColumnArr(Sequence)).Value) = False Then
                        sKey = DataStore(i, 1)
                        If Not Dict.exists(sKey) Then
                            Dict.Add sKey, DataStore(i, ResizeArr(Sequence))
                        Else
                            Dict.Item(sKey) = Dict.Item(sKey) + DataStore(i, ResizeArr(Sequence))
                        End If
                    Else
                        sKey = DataStore(i, ResizeArr(Sequence))
                        If Not Dict.exists(sKey) Then
                            Dict.Add sKey, DataStore(i, ResizeArr(Sequence))
                        Else
                            Dict.Item(sKey) = Dict.Item(sKey) + DataStore(i, 1)
                        End If
                    End If
                Next i
        End If
    End With 'kiem tra o dau tien bat dau du lieu cua bang neu la text thi gan lam key khong thi gan lam item
    '____________________________________________________________________________
Next Sequence
SArr = Sheets("Data").Range(Cells(3, 2), Cells(1000, 2).End(xlUp)).Value 'DANG LOI CHO NAY, TUY CO QUY TRINH NHUNG VAN CHUA BIET SUA SAO
ReDim RArr(1 To UBound(SArr, 1), 1 To 1)
For i = 1 To UBound(SArr, 1)
    If Dict.exists(SArr(i, 1)) Then
        RArr(i, 1) = Dict.Item(SArr(i, 1))
    Else
        RArr(i, 1) = 0
    End If
Next
Sheets("Data").Range("D3:D1000").ClearContents
Sheets("Data").Range("D3").Resize(UBound(SArr, 1), 1) = RArr
End Sub
 

File đính kèm

Upvote 0
PHP:
SheetArr = Array(1, 2, 4, 5, 6, 7, 8)

    '____
SArr = Sheets("Data").Range(Cells(3, 2), Cells(1000, 2).End(xlUp)).Value 'DANG LOI CHO NAY, TUY CO QUY TRINH NHUNG VAN CHUA BIET SUA SAO
1. Cách làm (quy trình) đúng nhưng chưa hay
2. SheetArr = Array(1, 2, 4, 5, 6, 7, 8)
Sheets(1) luôn luôn là sheet đầu tiên bên trái, và tăng theo thứ tự từ trái qua phải, không liên quan đến sheet code name. SheetArr đúng vẫn cứ là (2, 3, 4, 5, 6, 7, 8). Cách lấy thứ tự này có cái nguy hiểm là khi người ta di dời thứ tự sheet trên sheet tab sẽ bị sai. Chẳng thà lấy SheetName hoặc sheetCodeName
3. Kiểm tra bảng không có dữ liệu: Dài dòng quá. đơn giản là DataRw > RowArr(Sequence) là có dữ liệu
4. Dữ liệu trên 10.000 dòng mà tính DataRw đứng từ 1000 up lên là lên thẳng dòng tiêu đề. Phải đứng từ 100.000
5. SArr = Sheets("Data").Range(Cells(3, 2), Cells(1000, 2).End(xlUp)).Value (lỗi)
Cells thiếu tên sheet, đứng từ sheet bất kỳ không phải sheet Data sẽ bị hiểu là Cells của sheet hiện hành.
6. Sao code không để trong module mà để trong sheet?
 
Upvote 0
Upvote 0
1. Cách làm (quy trình) đúng nhưng chưa hay
2. SheetArr = Array(1, 2, 4, 5, 6, 7, 8)
Sheets(1) luôn luôn là sheet đầu tiên bên trái, và tăng theo thứ tự từ trái qua phải, không liên quan đến sheet code name. SheetArr đúng vẫn cứ là (2, 3, 4, 5, 6, 7, 8). Cách lấy thứ tự này có cái nguy hiểm là khi người ta di dời thứ tự sheet trên sheet tab sẽ bị sai. Chẳng thà lấy SheetName hoặc sheetCodeName
3. Kiểm tra bảng không có dữ liệu: Dài dòng quá. đơn giản là DataRw > RowArr(Sequence) là có dữ liệu
4. Dữ liệu trên 10.000 dòng mà tính DataRw đứng từ 1000 up lên là lên thẳng dòng tiêu đề. Phải đứng từ 100.000
5. SArr = Sheets("Data").Range(Cells(3, 2), Cells(1000, 2).End(xlUp)).Value (lỗi)
Cells thiếu tên sheet, đứng từ sheet bất kỳ không phải sheet Data sẽ bị hiểu là Cells của sheet hiện hành.
6. Sao code không để trong module mà để trong sheet?
Vậy quá nhiều lỗi. Do f8 nó cứ chảy thẳng qua vòng lặp nên chưa kiểm tra đc hết ạ. Cháu sửa để nó chạy kỳ được thì thôi!
 
Lần chỉnh sửa cuối:
Upvote 0
Vậy quá nhiều lỗi. Do f8 nó cứ chảy thẳng qua vòng lặp nên chưa kiểm tra đc hết ạ.
Thay vì phải khai "tùm lum" sao không khai báo trực quan luôn trong từng sheet.
Ví dụ Nhập "B6" vào ô A1 của sheet CH1 ... là vị trí bắt đầu của bảng dữ liệu. Đây là dòng tiêu đề của bảng dữ liệu, tiêu đề phải có, không để trống.
PHP:
Option Explicit

Public Sub GPE()
Dim Dic As Object, sArr(), Ws As Worksheet, WsName As Variant
Dim I As Long, J As Long, R As Long, x As Long, Cols As Long, ColMa As Long, ColSL As Long
Dim Ma As String, SL As String, Txt As String, ViTri As String
Set Dic = CreateObject("Scripting.Dictionary")
    WsName = Array("CH1", "CH2", "CH3", "CH4", "CH5", "CH6", "CH7")
    Ma = "M?":  SL = "SL*"
For x = LBound(WsName) To UBound(WsName)
    With Sheets(WsName(x))
        If .Range("A1") <> Empty Then
            ViTri = .Range("A1").Value  'Vi tri cell bat dau cua bang du lieu'
            If .Range(ViTri).Offset(1) <> Empty Then
                R = .Range(ViTri).End(xlDown).Row - .Range(ViTri).Row + 1
                Cols = .Range(ViTri).End(xlToRight).Column - .Range(ViTri).Column + 1
                sArr = .Range(ViTri).Resize(R, Cols).Value
                For J = 1 To Cols
                    If sArr(1, J) Like Ma Then ColMa = J    'Cot Ma trong mang'
                    If sArr(1, J) Like SL Then ColSL = J    'Cot SL trong mang'
                Next J
                For I = 1 To R
                    Txt = sArr(I, ColMa)
                    Dic.Item(Txt) = Dic.Item(Txt) + sArr(I, ColSL)
                Next I
            End If
        End If
    End With
Next x
With Sheets("Data")
    sArr = .Range("B3", .Range("B10000").End(xlUp)).Resize(, 3).Value
    R = UBound(sArr)
    For I = 1 To R
        sArr(I, 3) = Dic.Item(sArr(I, 1))
    Next I
    .Range("B3").Resize(R, 3) = sArr
End With
Set Dic = Nothing
End Sub
 

File đính kèm

Upvote 0
Thay vì phải khai "tùm lum" sao không khai báo trực quan luôn trong từng sheet.
Ví dụ Nhập "B6" vào ô A1 của sheet CH1 ... là vị trí bắt đầu của bảng dữ liệu. Đây là dòng tiêu đề của bảng dữ liệu, tiêu đề phải có, không để trống.
Được trần đi trần lại cách duyệt thế thì đúng là quá dễ học "Không thầy đố mày làm nên". Chúng cháu cảm ơn bác bac @Ba Tê.
 
Upvote 0
Thay vì phải khai "tùm lum" sao không khai báo trực quan luôn trong từng sheet.
Ví dụ Nhập "B6" vào ô A1 của sheet CH1 ... là vị trí bắt đầu của bảng dữ liệu. Đây là dòng tiêu đề của bảng dữ liệu, tiêu đề phải có, không để trống.
Mã:
With Sheets("Data")  
...
sArr(I, 3) = Dic.Item(sArr(I, 1))
    .Range("B3").Resize(R, 3) = sArr
Các bài tập cho con nhỏ này tôi đang cho dữ liệu càng ngày càng lung tung, và cách xử lý mang tính kế thừa. Sự lung tung còn có thể là ở chỗ tiêu đề không giống nhau, nên cách của anh có khi không phù hợp.
Ngoài ra bảng danh mục ở sheet Data có khi có những mặt hàng không bán được ở cửa hàng nào, nên sArr(I, 3) = Dic.Item(sArr(I, 1)) có khi bị lỗi. Cụ thể là MH06 và MH29 trong file có dữ liệu ngắn ngắn
 
Lần chỉnh sửa cuối:
Upvote 0
Các bài tập cho con nhỏ này tôi đang cho dữ liệu càng ngày càng lung tung, và cách xử lý mang tính kế thừa. Sự lung tung còn có thể là ở chỗ tiêu đề không giống nhau, nên cách của anh có khi không phù hợp.
Ngoài ra bảng danh mục ở sheet Data có khi có những mặt hàng không bán được ở cửa hàng nào, nên sArr(I, 3) = Dic.Item(sArr(I, 1)) có khi bị lỗi. Cụ thể là MH06 và MH29
Cách hiện tại giống như xiên thịt nướng, xiên 1 nhát 4 miếng thịt (ý nói 1 vòng for For Sequence = 0 To 6)
Phê cháu với! Sửa sáng đến giờ chạy kết quả vẫn sai! Chưa biết cái If-End nào sai ạ?
MH06 và MH29 chỗ này bài trước cháu cũng sai file Episode5 ở bài #73 cũng ra kết quả kiểu như bài #90,cũng chưa tìm được cách sử lý ạ?
kq.jpg
PHP:
Sub Episode6()
Dim DataRw As Long, i As Long
Dim ColumnArr, sKey As String, RowArr, SheetArr, ResizeArr
Dim Dict, SArr(), RArr()
Set Dict = CreateObject("Scripting.Dictionary")
ResizeArr = Array(3, 5, 7, 2, 2, 3, 3)
SheetArr = Array(2, 3, 4, 5, 6, 7, 8)
ColumnArr = Array(2, 4, 7, 3, 4, 6, 2)
RowArr = Array(7, 19, 10, 12, 17, 13, 6)
For Sequence = 0 To 6
   With Sheets(SheetArr(Sequence))
        DataRw = .Cells(1000000, ColumnArr(Sequence)).End(xlUp).Row
        DataStore = .Range(.Cells(RowArr(Sequence), ColumnArr(Sequence)), _
        .Cells(DataRw, ColumnArr(Sequence))).Resize(, ResizeArr(Sequence)).Value
            If (DataRw > RowArr(Sequence) And UBound(DataStore, 2) = ResizeArr(Sequence)) Then
                For i = 1 To UBound(DataStore, 1)
                    If IsNumeric(.Cells(DataRw, ColumnArr(Sequence)).Value) = False Then
                        sKey = DataStore(i, 1)
                        If Not Dict.exists(sKey) Then
                            Dict.Add sKey, DataStore(i, ResizeArr(Sequence))
                        Else
                            Dict.Item(sKey) = Dict.Item(sKey) + DataStore(i, ResizeArr(Sequence))
                        End If
                    Else
                        sKey = DataStore(i, ResizeArr(Sequence))
                        If Not Dict.exists(sKey) Then
                            Dict.Add sKey, DataStore(i, ResizeArr(Sequence))
                        Else
                            Dict.Item(sKey) = Dict.Item(sKey) + DataStore(i, 1)
                        End If
                    End If
                Next i
        End If
    End With
Next Sequence
With Sheets("Data")
SArr = Sheets("Data").Range(Cells(3, 2), Cells(1000000, 2).End(xlUp)).Value
ReDim RArr(1 To UBound(SArr, 1), 1 To 1)
For i = 1 To UBound(SArr, 1)
    If Dict.exists(SArr(i, 1)) Then
        RArr(i, 1) = Dict.Item(SArr(i, 1))
    Else
        RArr(i, 1) = 0
    End If
Next
.Range("D3:D1000").ClearContents
.Range("D3").Resize(UBound(SArr, 1), 1) = RArr
End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
1615692169172.png
Mã code này em chỉ chọn được 1 dòng để coppy dữ liệu, nhưng muốn chọn nhiều dòng bất kỳ để coppy thì mình làm như thế nào ạ?. Em cảm ơn
 
Upvote 0
View attachment 255388
Mã code này em chỉ chọn được 1 dòng để coppy dữ liệu, nhưng muốn chọn nhiều dòng bất kỳ để coppy thì mình làm như thế nào ạ?. Em cảm ơn
Muốn copy Range có nhiều dòng nhiều cột thì phải copy thành hình chữ nhật kích thước cạnh theo chiều ngang có số cột lớn hơn 1, theo chiều thẳng đứng thì có số dòng lớn lơn 1
Range("A" & b, "ad" & c). c phải Tờ O to hơn bờ ê b trong công thức của bạn. Tính ra c cho vào là đc nhé! (post bài lên GPE bạn làm theo bài #1 và bài #18 của chủ đề này nhé)
 
Lần chỉnh sửa cuối:
Upvote 0
Cách hiện tại giống như xiên thịt nướng, xiên 1 nhát 4 miếng thịt (ý nói 1 vòng for For Sequence = 0 To 6)
PHP:
SArr = Sheets("Data").Range(Cells(3, 2), Cells(1000000, 2).End(xlUp)).Value
Tôi chạy ra kết quả đúng. Dòng code SArr vẫn thiếu 2 cái chấm mắm tôm và mắm cáy
Bài đã được tự động gộp:

Nếu đã khai báo thêm 1 Arr thì thêm hẳn thông số cột số lượng. Tách DataStore thành 2 mảng mỗi mảng 1 cột StoreCode và StoreQty. StoreCode là Key, StoreQty là item
PHP:
    ItemArr = Array(4, 8, 13, 4, 4, 6)
    With Sheets(ShArr(Seq))
        DataRw = .Cells(100000, ColumnArr(Seq)).End(xlUp).Row
        StoreCode = .Range(.Cells(RowArr(Seq), ColumnArr(Seq)), _
        .Cells(DataRw, ColumnArr(Seq))).Value2
        StoreQty = .Range(.Cells(RowArr(Seq), ItemArr(Seq)), _
        .Cells(DataRw, ItemArr(Seq))).Value2
        For i = 1 To UBound(StoreCode, 1)
            sKey = StoreCode(i, 1)
            If Not Dict.exists(sKey) Then
                Dict.Add sKey, StoreQty(i, 1)
            Else
                Dict.Item(sKey) = Dict.Item(sKey) + StoreQty(i, 1)
            End If
        Next
        End With
    Next
 
Lần chỉnh sửa cuối:
Upvote 0
Upvote 0
Muốn copy Range có nhiều dòng nhiều cột thì phải copy thành hình chữ nhật kích thước cạnh theo chiều ngang có số cột lớn hơn 1, theo chiều thẳng đứng thì có số dòng lớn lơn 1
Range("A" & b, "ad" & c). c phải Tờ O to hơn bờ ê b trong công thức của bạn. Tính ra c cho vào là đc nhé! (post bài lên GPE bạn làm theo bài #1 và bài #18 của chủ đề này nhé)
Cảm ơn bạn nhiều
Bài đã được tự động gộp:

Muốn copy Range có nhiều dòng nhiều cột thì phải copy thành hình chữ nhật kích thước cạnh theo chiều ngang có số cột lớn hơn 1, theo chiều thẳng đứng thì có số dòng lớn lơn 1
Range("A" & b, "ad" & c). c phải Tờ O to hơn bờ ê b trong công thức của bạn. Tính ra c cho vào là đc nhé! (post bài lên GPE bạn làm theo bài #1 và bài #18 của chủ đề này nhé)
Cho mình hỏi GPE là ơ đâu v ạ
 
Lần chỉnh sửa cuối:
Upvote 0
Cảm ơn bạn nhiều
Bài đã được tự động gộp:


Cho mình hỏi GPE là ơ đâu v ạ
GPE = giaphapexcel. Học vba chắc hẳn rồi bạn cũng phải post bài để hỏi.
Nếu post bài thì để mọi người tiện giúp bạn nhất cũng phải biết cách chèn code (bạn biết chèn ảnh rồi, nhưng chèn được code vào mới tiện cho người giúp).
Chúc bạn thâu được nhiều kiến thức vba.
 
Upvote 0
Tôi chạy ra kết quả đúng. Dòng code SArr vẫn thiếu 2 cái chấm mắm tôm và mắm cáy
Code này cho ra kết quả của cháu và của bác @Ba Tê là giống nhau( sau khi sửa bài #90 thêm 2 dấu chấm trước Cells của SArr)
PHP:
Sub Dict_Episode_6()
Dim DataRw As Long, i As Long
Dim ColumnArr, sKey As String, RowArr, SheetArr, ResizeArr
Dim Dict, SArr(), RArr()
Set Dict = CreateObject("Scripting.Dictionary")
ResizeArr = Array(3, 5, 7, 2, 2, 3, 3)
SheetArr = Array(2, 3, 4, 5, 6, 7, 8)
ColumnArr = Array(2, 4, 7, 3, 4, 6, 2)
RowArr = Array(7, 19, 10, 12, 17, 13, 6)
For Sequence = 0 To 6
   With Sheets(SheetArr(Sequence))
        DataRw = .Cells(1000000, ColumnArr(Sequence)).End(xlUp).Row
        DataStore = .Range(.Cells(RowArr(Sequence), ColumnArr(Sequence)), _
        .Cells(DataRw, ColumnArr(Sequence))).Resize(, ResizeArr(Sequence)).Value
            If (DataRw > RowArr(Sequence) And UBound(DataStore, 2) = ResizeArr(Sequence)) Then
                For i = 1 To UBound(DataStore, 1)
                    If IsNumeric(.Cells(DataRw, ColumnArr(Sequence)).Value) = False Then
                        sKey = DataStore(i, 1)
                        If Not Dict.exists(sKey) Then
                            Dict.Add sKey, DataStore(i, ResizeArr(Sequence))
                        Else
                            Dict.Item(sKey) = Dict.Item(sKey) + DataStore(i, ResizeArr(Sequence))
                        End If
                    Else
                        sKey = DataStore(i, ResizeArr(Sequence))
                        If Not Dict.exists(sKey) Then
                            Dict.Add sKey, DataStore(i, ResizeArr(Sequence))
                        Else
                            Dict.Item(sKey) = Dict.Item(sKey) + DataStore(i, 1)
                        End If
                    End If
                Next i
        End If
    End With
Next Sequence
With Sheets("Data")
SArr = .Range(.Cells(3, 2), .Cells(1000000, 2).End(xlUp)).Value
ReDim RArr(1 To UBound(SArr, 1), 1 To 1)
For i = 1 To UBound(SArr, 1)
    If Dict.exists(SArr(i, 1)) Then
        RArr(i, 1) = Dict.Item(SArr(i, 1))
    Else
        RArr(i, 1) = 0
    End If
Next
.Range("D3:D1000").ClearContents
.Range("D3").Resize(UBound(SArr, 1), 1) = RArr
End With
End Sub

Còn phần bonus khi thêm ItemArr và tách DataStore ra làm 2 thì lại giống kết quả bài #90 của cháu. Xin chú giúp cho cháu cái ảnh kết quả của bài chú để tiện kiểm tra ạ? Phần code như sau:
PHP:
Sub Dict_Episode_6_bonus()
Dim DataRw As Long, i As Long
Dim ColumnArr, sKey As String, RowArr, SheetArr, ResizeArr
Dim Dict, SArr(), RArr()
Set Dict = CreateObject("Scripting.Dictionary")
ResizeArr = Array(3, 5, 7, 2, 2, 3, 3)
ItemArr = Array(4, 8, 13, 4, 4, 6, 4)
ShArr = Array(2, 3, 4, 5, 6, 7, 8)
ColumnArr = Array(2, 4, 7, 3, 4, 6, 2)
RowArr = Array(7, 19, 10, 12, 17, 13, 6)
For Seq = 0 To 6
    With Sheets(ShArr(Seq))
        DataRw = .Cells(100000, ColumnArr(Seq)).End(xlUp).Row
        StoreCode = .Range(.Cells(RowArr(Seq), ColumnArr(Seq)), _
        .Cells(DataRw, ColumnArr(Seq))).Value2
        StoreQty = .Range(.Cells(RowArr(Seq), ItemArr(Seq)), _
        .Cells(DataRw, ItemArr(Seq))).Value2
        For i = 1 To UBound(StoreCode, 1)
            sKey = StoreCode(i, 1)
            If Not Dict.exists(sKey) Then
                Dict.Add sKey, StoreQty(i, 1)
            Else
                Dict.Item(sKey) = Dict.Item(sKey) + StoreQty(i, 1)
            End If
        Next
    End With
Next Seq
With Sheets("Data")
SArr = .Range(.Cells(3, 2), .Cells(1000000, 2).End(xlUp)).Value
ReDim RArr(1 To UBound(SArr, 1), 1 To 1)
For i = 1 To UBound(SArr, 1)
    If Dict.exists(SArr(i, 1)) Then
        RArr(i, 1) = Dict.Item(SArr(i, 1))
    Else
        RArr(i, 1) = 0
    End If
Next
.Range("D3:D1000").ClearContents
.Range("D3").Resize(UBound(SArr, 1), 1) = RArr
End With
End Sub
Xin chú chỉ cho giá trị value với Value và Value2 thì:
- Value nằm trong Value2
- Value và Value2 chồng một phần vào nhau
- Value và Value2 tách rời nhau
****** Nhân có cách tách DataStore ra làm 2, nhờ chú thêm cho 1 đề bài theo kịch bản như sau: Ban đầu các cột của Bảng có số dòng bằng nhau, giờ tách ra ra khỏi bảng và so le nhau ( so le nhau nhưng số dòng vẫn giữ nguyên, ví dụ cột mã hàng thì bắt đầu cells(1,1) còn cột số lượng bắt đầu cells(10,4))
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Còn phần bonus khi thêm ItemArr và tách DataStore ra làm 2 thì lại giống kết quả bài #90 của cháu.
Xin chú chỉ cho giá trị value với Value và Value2
Khi tách 2 mảng thì mảng nào mảng nấy có ý nghĩa riêng: mã và số lượng. Chứ không phải cột đầu và cột cuối của 1 mảng
ColumnArr phải là = Array(2, 4, 7, 3, 5, 8, 2)
chứ không phải = Array(2, 4, 7, 3, 4, 6, 2)
---------
Phải chú ý khai báo biến, gán giá trị biến, ... khi sửa code chứ? Biến mới không khai báo thêm, biến cũ không dùng thì lại cứ gán giá trị. (ResizeArr)
------
Value và Value2: Trong 1 số trường hợp của kiểu dữ liệu, Value2 nhanh hơn Value 1 tẹo nhất là khi dữ liệu trên 50 ngàn dòng. Thôi đừng cố, tôi còn quên mất rồi chứ đừng nói là con vịt tắm nước sôi
 
Upvote 0

Bài viết mới nhất

Back
Top Bottom