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ô Bé Dễ Thương]

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)

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]

 

[Cô Bé Dễ Thương]

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.

 

[Hân Đỗ]

Cho em hỏi bị lỗi runtime-13 là sao vậy ạ?

 

[Cô Bé Dễ Thương]

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

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

 

[ptm0412]

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?

 

[ptm0412]

Cho em hỏi bị lỗi runtime-13 là sao vậy ạ?

Cú pháp Range là Range(Cell 1, Cell 2)
còn cú pháp Cell là Cells(dòng, cột) của chỉ 1 ô, Cells của bạn chứa 2 ô

 

[Cô Bé Dễ Thương]

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!

 

[Ba Tê]

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.

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

 

[Cô Bé Dễ Thương]

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ê.

 

[ptm0412]

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.

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

 

[Cô Bé Dễ Thương]

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ý ạ?

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

 

[Hân Đỗ]

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

 

[Cô Bé Dễ Thương]

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é)

 

[ptm0412]

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)

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: 14/3/21

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

    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

 

[Cô Bé Dễ Thương]

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.....

Nghĩa cái code của cháu hiện chỉ sai code của phần SArr thôi phải không ạ

 

[ptm0412]

Nghĩa cái code của cháu hiện chỉ sai code của phần SArr thôi phải không ạ

Nghĩa (là) sửa chỗ ấy và test lại. Còn vụ MH06 và MH29 thì dữ liệu thực tế có hay không phải tìm bằng mắt. Ngoài ra dời code ra module chưa?

 

[Cô Bé Dễ Thương]

Vâ

Nghĩa (là) sửa chỗ ấy và test lại. Còn vụ MH06 và MH29 thì dữ liệu thực tế có hay không phải tìm bằng mắt. Ngoài ra dời code ra module chưa?

Vâng ạ. Chiều cháu sửa lại và kiểm tra.

 

[Hâ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é)

Cảm ơn bạn nhiều

Bài đã được tự động gộp: 14/3/21

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 ạ

 

[Cô Bé Dễ Thương]

Cảm ơn bạn nhiều

Bài đã được tự động gộp: 14/3/21

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.

 

[Cô Bé Dễ Thương]

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)

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:

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))

 

[ptm0412]

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