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!

Liên hệ QC
Cô Bé Dễ Thương

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:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Cô Bé Dễ Thương đã viết:
Vâng.View attachment 255557
a = 0 nghĩa là bàng dữ liệu có 1 dòng
a > 0 đang có 2 dòng trở lên.
Nhưng vẫn chưa hiểu sao nó không thấy 1 tỷ đâu ạ :wallbash:
Nhấp chuột vào đây để mở rộng...
Vụ chỉ có 1 dòng 1 cột, 1 mình ên không tạo được "chợ" mảng, có thể xử lý đơn giản là mượn người kế bên, lấy 2 cột
StoreCode = .Range(.Cells(RowArrCode(Seq), ColumnArrCode(Seq)), _
.Cells(DataRwCode, ColumnArrCode(Seq)+1)).Value
 
Upvote 0
Đã hoàn thành nà ná na, giờ đã hiểu DataArr là giá trị đơn, xét trực tiếp không cần vòng lặp (bao gồm StoreCode và SoreQty) là câu này ạ!
PHP: 
Sub Dict_Episode_8_finish()
Dim DataRw As Long, i As Long, sKey As String
Dim Dict, SArr(), RArr(), txt As String, txt2 As String
Dim ShArr, ColumnArrCode, RowArrCode, ColumnArrQty, RowArrQty, StoreCode, StoreQty
Set Dict = CreateObject("Scripting.Dictionary")
ShArr = Array(2, 3, 4, 5, 6, 7, 8)
ColumnArrCode = Array(2, 4, 7, 3, 12, 12, 2)
RowArrCode = Array(7, 19, 10, 12, 11, 8, 6)
ColumnArrQty = Array(8, 14, 20, 7, 4, 6, 7)
RowArrQty = Array(9, 7, 15, 4, 17, 13, 13)
For Seq = 0 To 6
    With Sheets(ShArr(Seq))
        DataRwCode = .Cells(1000000, ColumnArrCode(Seq)).End(xlUp).Row
        DataRwQty = .Cells(1000000, ColumnArrQty(Seq)).End(xlUp).Row
        StoreCode = .Range(.Cells(RowArrCode(Seq), ColumnArrCode(Seq)), _
        .Cells(DataRwCode, ColumnArrCode(Seq))).Value
        StoreQty = .Range(.Cells(RowArrQty(Seq), ColumnArrQty(Seq)), _
        .Cells(DataRwQty, ColumnArrQty(Seq))).Value
        a = DataRwCode - RowArrCode(Seq)
            If (a = 0) Then
'=====================================================================
'Toàn bộ đoạn code trong khoảng đánh dấu này thật nhớ đời
                mc = .Range(.Cells(RowArrCode(Seq), ColumnArrCode(Seq)), _
                .Cells(DataRwCode, ColumnArrCode(Seq))).Value
                mq = .Range(.Cells(RowArrQty(Seq), ColumnArrQty(Seq)), _
                .Cells(DataRwQty, ColumnArrQty(Seq))).Value
                txt = Mid(mc, 1, 2)
                txt2 = Mid(mc, 3, 2)
                If (IsEmpty(mc) = False And Len(mc) = 4 And txt = "MH" And IsNumeric(txt2) = True _
                And IsEmpty(mq) = False And IsNumeric(mq) = True) Then
                    sKey = mc
                    If Not Dict.exists(sKey) Then
                        Dict.Add sKey, mc
                    Else
                        Dict.Item(sKey) = Dict.Item(sKey) + mq
                    End If
                End If
            End If
'=======================================================================
            If (a > 0) Then
            For i = 1 To UBound(StoreCode, 1)
                mc = StoreCode(i, 1): mq = StoreQty(i, 1): txt = Mid(mc, 1, 2): txt2 = Mid(mc, 3, 2)
                If (IsEmpty(mc) = False And Len(mc) = 4 And txt = "MH" And IsNumeric(txt2) = True _
                And IsEmpty(mq) = False And IsNumeric(mq) = True) Then
                    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
                End If
            Next
            End If
        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").Resize(UBound(SArr, 1), 1) = RArr
End With
End Sub
Bài đã được tự động gộp:

HieuCD đã viết:
Vụ chỉ có 1 dòng 1 cột, 1 mình ên không tạo được "chợ" mảng, có thể xử lý đơn giản là mượn người kế bên, lấy 2 cột
StoreCode = .Range(.Cells(RowArrCode(Seq), ColumnArrCode(Seq)), _
.Cells(DataRwCode, ColumnArrCode(Seq)+1)).Value
Nhấp chuột vào đây để mở rộng...
Tạm thời em chưa test theo cách thầy được. Nhưng chỗ a = 0 vì có 1 dòng nên mảng là một giá trị , không truy xuất theo kiểu Arr(i,j) được nên phải khuân cả tảng theo dấu bằng của nó!
Chỗ đoan code xét a = 0 ấy thầy!
PHP: 
- Nếu 1 giá trị mà gán StoreCode lỗi ngay
Phải gán  .Range(.Cells(RowArrCode(Seq), ColumnArrCode(Seq)),.Cells(DataRwCode, ColumnArrCode(Seq))).Value
- Và  StoreQty lỗi phải gán .Range(.Cells(RowArrQty(Seq), ColumnArrQty(Seq)), .Cells(DataRwQty, ColumnArrQty(Seq))).Value
Thì mới được thầy @HieuCD ơi.
Vẫn biết Array là cao cấp, đến đây được Chú chỉ cho mà mãi mới mò ra được ạ! Sướng thiệt. Nhớ đời!
 
Lần chỉnh sửa cuối:
Upvote 0
Cô Bé Dễ Thương đã viết:
Đã hoàn thành nà ná na, giờ đã hiểu DataArr là giá trị đơn, xét trực tiếp không cần vòng lặp (bao gồm StoreCode và SoreQty) là câu này ạ!
PHP: 
Sub Dict_Episode_8_finish()
Dim DataRw As Long, i As Long, sKey As String
Dim Dict, SArr(), RArr(), txt As String, txt2 As String
Dim ShArr, ColumnArrCode, RowArrCode, ColumnArrQty, RowArrQty, StoreCode, StoreQty
Set Dict = CreateObject("Scripting.Dictionary")
ShArr = Array(2, 3, 4, 5, 6, 7, 8)
ColumnArrCode = Array(2, 4, 7, 3, 12, 12, 2)
RowArrCode = Array(7, 19, 10, 12, 11, 8, 6)
ColumnArrQty = Array(8, 14, 20, 7, 4, 6, 7)
RowArrQty = Array(9, 7, 15, 4, 17, 13, 13)
For Seq = 0 To 6
    With Sheets(ShArr(Seq))
        DataRwCode = .Cells(1000000, ColumnArrCode(Seq)).End(xlUp).Row
        DataRwQty = .Cells(1000000, ColumnArrQty(Seq)).End(xlUp).Row
        StoreCode = .Range(.Cells(RowArrCode(Seq), ColumnArrCode(Seq)), _
        .Cells(DataRwCode, ColumnArrCode(Seq))).Value
        StoreQty = .Range(.Cells(RowArrQty(Seq), ColumnArrQty(Seq)), _
        .Cells(DataRwQty, ColumnArrQty(Seq))).Value
        a = DataRwCode - RowArrCode(Seq)
            If (a = 0) Then
'=====================================================================
'Toàn bộ đoạn code trong khoảng đánh dấu này thật nhớ đời
                mc = .Range(.Cells(RowArrCode(Seq), ColumnArrCode(Seq)), _
                .Cells(DataRwCode, ColumnArrCode(Seq))).Value
                mq = .Range(.Cells(RowArrQty(Seq), ColumnArrQty(Seq)), _
                .Cells(DataRwQty, ColumnArrQty(Seq))).Value
                txt = Mid(mc, 1, 2)
                txt2 = Mid(mc, 3, 2)
                If (IsEmpty(mc) = False And Len(mc) = 4 And txt = "MH" And IsNumeric(txt2) = True _
                And IsEmpty(mq) = False And IsNumeric(mq) = True) Then
                    sKey = mc
                    If Not Dict.exists(sKey) Then
                        Dict.Add sKey, mc
                    Else
                        Dict.Item(sKey) = Dict.Item(sKey) + mq
                    End If
                End If
            End If
'=======================================================================
            If (a > 0) Then
            For i = 1 To UBound(StoreCode, 1)
                mc = StoreCode(i, 1): mq = StoreQty(i, 1): txt = Mid(mc, 1, 2): txt2 = Mid(mc, 3, 2)
                If (IsEmpty(mc) = False And Len(mc) = 4 And txt = "MH" And IsNumeric(txt2) = True _
                And IsEmpty(mq) = False And IsNumeric(mq) = True) Then
                    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
                End If
            Next
            End If
        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").Resize(UBound(SArr, 1), 1) = RArr
End With
End Sub
Bài đã được tự động gộp:


Chỗ đoan code xét a = 0 ấy thầy!
PHP: 
- Nếu 1 giá trị mà gán StoreCode lỗi ngay
Phải gán  .Range(.Cells(RowArrCode(Seq), ColumnArrCode(Seq)),.Cells(DataRwCode, ColumnArrCode(Seq))).Value
- Và  StoreQty lỗi phải gán .Range(.Cells(RowArrQty(Seq), ColumnArrQty(Seq)), .Cells(DataRwQty, ColumnArrQty(Seq))).Value
Thì mới được thầy @HieuCD ơi.
Vẫn biết Array là cao cấp, đến đây được Chú chỉ cho mà mãi mới mò ra được ạ! Sướng thiệt. Nhớ đời!
Nhấp chuột vào đây để mở rộng...
Lấy 2 cột, a=0 hay a>0 đều ngon
 
Upvote 0
HieuCD đã viết:
Lấy 2 cột, a=0 hay a>0 đều ngon
Nhấp chuột vào đây để mở rộng...
Vậy ạ. Mai em test để tổng hợp các bài trong top này lại ạ! Thầy đi nghỉ sớm ạ!
Chú Mỹ chưa đi ngủ sao? Túm lại thay vì nhẹ nhàng xách theo StoreCode và StoreQty thì phải khuân tất cả các thứ cồng kềnh sau dấu bằng của nó vào trường hợp a = 0 chú ạ. Thế mới hiểu cái mảng Arr(i) và Arr(i,j) là gì đấy chú Mỹ ạ!
 
Upvote 0
Cô Bé Dễ Thương đã viết:
Vậy ạ. Mai em test để tổng hợp các bài trong top này lại ạ! Thầy đi nghỉ sớm ạ!
Chú Mỹ chưa đi ngủ sao? Túm lại thay vì nhẹ nhàng xách theo StoreCode và StoreQty thì phải khuân tất cả các thứ cồng kềnh sau dấu bằng của nó vào trường hợp a = 0 chú ạ. Thế mới hiểu cái mảng Arr(i) và Arr(i,j) là gì đấy chú Mỹ ạ!
Nhấp chuột vào đây để mở rộng...
Mới hơn 10 giờ sáng :)
Chúc ngủ ngon
 
Upvote 0
Cô Bé Dễ Thương đã viết:
Vậy ạ. Mai em test để tổng hợp các bài trong top này lại ạ! Thầy đi nghỉ sớm ạ!
Chú Mỹ chưa đi ngủ sao? Túm lại thay vì nhẹ nhàng xách theo StoreCode và StoreQty thì phải khuân tất cả các thứ cồng kềnh sau dấu bằng của nó vào trường hợp a = 0 chú ạ. Thế mới hiểu cái mảng Arr(i) và Arr(i,j) là gì đấy chú Mỹ ạ!
Nhấp chuột vào đây để mở rộng...
Lấy Arr thêm cột là 1 giải pháp khiến cho viết code nhẹ nhàng nhưung với dữ liệu lớn (vài trăm ngàn, 1 triệu) thì tổn hao bộ nhớ. Nhất là 6/7 cửa hàng có dữ liệu nhiều, chỉ 1 cửa hàng có 1 dòng.
Còn mục số 3: mặt hàng #$% chưa có trong danh mục sẽ có 3 tuỳ chọn:
- Buộc người dùng phải khai báo trước rồi mới được mua bán, nếu không thì mất doanh số ráng chịu
- Thêm 1 vòng lặp duyệt Dict, nếu chưa có trong danh mục thì thêm 1 dòng vào danh mục
- Dùng 1 mảng kết quả song song với Dict, mảng này có thể có nhiều cột như Mã, Tên, SL. Số lượng không cộng dồn trên item của Dict mà cộng dồn trên cột SL của mảng kết quả. Cuối cùng đập 1 phát kết quả xuống sheet.

Không bao giờ xét cấu trúc mã. Mã nếu toàn ký tự chữ hay toàn ký số, hay mã dài 10 ký tự chữ và số lẫn lộn, lấy gì phân biệt
 
Upvote 0
ptm0412 đã viết:
Lấy Arr thêm cột là 1 giải pháp khiến cho viết code nhẹ nhàng nhưung với dữ liệu lớn (vài trăm ngàn, 1 triệu) thì tổn hao bộ nhớ. Nhất là 6/7 cửa hàng có dữ liệu nhiều, chỉ 1 cửa hàng có 1 dòng.
Còn mục số 3: mặt hàng #$% chưa có trong danh mục sẽ có 3 tuỳ chọn:
- Buộc người dùng phải khai báo trước rồi mới được mua bán, nếu không thì mất doanh số ráng chịu
- Thêm 1 vòng lặp duyệt Dict, nếu chưa có trong danh mục thì thêm 1 dòng vào danh mục
- Dùng 1 mảng kết quả song song với Dict, mảng này có thể có nhiều cột như Mã, Tên, SL. Số lượng không cộng dồn trên item của Dict mà cộng dồn trên cột SL của mảng kết quả. Cuối cùng đập 1 phát kết quả xuống sheet.

Không bao giờ xét cấu trúc mã. Mã nếu toàn ký tự chữ hay toàn ký số, hay mã dài 10 ký tự chữ và số lẫn lộn, lấy gì phân biệt
Nhấp chuột vào đây để mở rộng...
Vâng ạ. Khả năng có thức thứ 9 chăng? Cháu cố gắng biên tập lại Top này, vì nó như cái đề cương mà lại ra sản phẩm dùng được luôn. Hay nhất là có chỗ sai, rồi sửa sai. Rất có khả năng với Top này có rất nhiều người 1 tuần là trang bị đủ kiến thức để tự học và đọc code được.
 
Lần chỉnh sửa cuối:
Upvote 0
Cô Bé Dễ Thương đã viết:
Chị em thôi, em mới 18+. Gọi chị là tỷ tỷ rồi.
- Hồi đi học đại học cả lớp không ai làm thêm tải trong động đất trong đồ án tốt nghiệp. Mỗi mình muội vì yêu thích nên lao vào làm. Hội bạn thì cứ file excel cũ, bản vẽ cũ để sửa lại. Còn muội phải tự thiết kế file excel cho riêng mình và bản vẽ cực kỳ mất công
- Nhưng đến giáp năm mới năm nay thời điểm đó quay lại diễn đàn còn không nhớ được gì Excel ấy. Nhân covi covit mới thấy cái các cái file ngày xưa mình viết sao nặng quá thể. Nên mới học VBA. Mà tính em đã học là phải học kỳ được. Rồi giờ cảm thấy hiểu được code và tự kiếm tài liệu được. Cực nhưng vui thật!
Nhấp chuột vào đây để mở rộng...
Thời teen ai chả từng tài năng một cách đặc biệt, những ý tưởng vượt thời gian vượt không gian, tầm cỡ 10 năm 20 năm sau thì những công nghệ đương thời mới phát triển kịp để giải quyết các ý tưởng ngày đò. Muội học ngành ghì mà "excel, bản vẻ cũ, vba..."
 
Upvote 0
Đây cũng là một phần rất cơ bản nhưng không kém quan trọng. Bài này của mình biên soạn nên nhìn có vẻ hơi ngố xíu.
Mã: 
Sub Chon_1_Cell_Da_Biet_1()
Range("A1").Select
End Sub
Sub Chon_1_Cell_Da_Biet_2()
[A1].Select
End Sub
Sub Chon_1_Cell_Da_Biet_3()
Cells(1, 1).Select
End Sub
Sub Chon_1_Cell_Da_Biet_4()
Cells(1, "A").Select
End Sub
Sub Chon_1_Cell_Da_Biet_5()
Range("A" & 1).Select
End Sub
Sub Chon_1_Vung_Da_Biet_1()
Range("A1:B5").Select
End Sub
Sub Chon_1_Vung_Da_Biet_2()
[A1:B5].Select
End Sub
Sub Chon_1_Vung_Da_Biet_3()
Range("A1:B" & 5).Select
End Sub
Sub Chon_1_Vung_Da_Biet_4()
Range("A" & 1 & ":B5").Select
End Sub
Sub Chon_2_Vung_Da_Biet_Khong_Lien_Tuc_1()
Range("B1:B5,D3:D10").Select
End Sub
Sub Chon_2_Vung_Da_Biet_Khong_Lien_Tuc_2()
Union(Range("B1:B5"), Range("D1:D5")).Select
End Sub
Sub Chon_2_Vung_Da_Biet_Khong_Lien_Tuc_3()
Union([B1:B5], [D1:D5]).Select
End Sub
Sub Chon_1_Cot_1()
Range("C:C").Select
End Sub
Sub Chon_1_Cot_2()
Range("C1").EntireColumn.Select
End Sub
Sub Chon_1_Cot_3()
Cells(1, 3).EntireColumn.Select
End Sub
Sub Chon_1_Cot_4()
Cells(1, "C").EntireColumn.Select
End Sub
Sub Chon_1_Cot_5()
Range("C" & 1).EntireColumn.Select
End Sub
Sub Chon_1_Cot_6()
Columns("C").Select
End Sub
Sub Chon_1_Cot_7()
Columns(3).Select
End Sub
Sub Chon_Nhieu_Cot_Lien_Tiep_1()
Range("C:E").Select
End Sub
Sub Chon_Nhieu_Cot_Lien_Tiep_2()
Columns("C:E").Select
End Sub
Sub Chon_Nhieu_Cot_Khong_Lien_Tiep()
Range("A:B,E:E,G:H").Select
End Sub
Sub Chon_1_Dong_1()
Range("3:3").Select
End Sub
Sub Chon_1_Dong_2()
Rows(3).Select
End Sub
Sub Chon_1_Dong_3()
Cells(3, 1).EntireRow.Select
End Sub
Sub Chon_1_Dong_4()
Cells(3, "A").EntireRow.Select
End Sub
Sub Chon_1_Dong_5()
Range("A" & 3).EntireRow.Select
End Sub
Sub Chon_1_Dong_6()
Range("A3").EntireRow.Select
End Sub
Sub Chon_Nhieu_Dong_Lien_Tiep_1()
Range("3:5").Select
End Sub
Sub Chon_Nhieu_Dong_Lien_Tiep_2()
Rows("3:5").Select
End Sub
Sub Chon_Nhieu_Dong_Khong_Lien_Tiep()
Union(Rows(3), Rows(5)).Select
End Sub
Sub Chon_1_Vung_Chua_Biet_Dong_Cuoi_1()
Range("A6", Range("I" & Rows.Count).End(3)).Select
End Sub
Sub Chon_1_Vung_Chua_Biet_Dong_Cuoi_2()
Range("A6", Range("A" & Rows.Count).End(3)).Resize(, 9).Select
End Sub
Sub Chon_1_Vung_Chua_Biet_Dong_Cuoi_Cot_Cuoi()
Dim LastRow As Long, LastCol As Long
LastRow = Range("A" & Rows.Count).End(3).Row
LastCol = Range("IV4").End(xlToLeft).Column
Range("A6", Range("A" & LastRow)).Resize(, LastCol).Select
End Sub
 
Upvote 0
Hic hic dồn nhiều việc quá mà bài 9 lại mới toanh với cháu!
Ở các bài trước trong TOP này thì Sheets("Data") có cột Mã và Tên mặt hàng. Nhưng đến bài số 9,Sheets("Datat") chẳng có gì (chết dở, toi thật ấy chứ)
khongdanhsach.jpg
Vậy thì làm cho Sheets("Data") ,nó có danh sách rồi, ốp bài 8 vào là ok
- Bài tập số 9 áp dụng Dictionary (cách đặt tên theo quy định)
- Mong chú Mỹ và các thầy cho cháu(em) cách giải thứ 2,3... để cháu có thể biên tập lại Top này.
- Sau đây là thức thứ 9 Dictionary Bí Truyền - Cửu Âm Chân Kinh (cái này em đặt)
PHP: 
Sub Dict_Episode_9()
Dim DataRw As Long, sKey As String, Dict, RArr()
Set Dict = CreateObject("Scripting.Dictionary")
ShArr = Array(2, 3, 4, 5, 6, 7, 8)
ColumnArrCode = Array(2, 4, 7, 3, 12, 12, 2)
RowArrCode = Array(7, 19, 10, 12, 11, 8, 6)
ColumnArrQty = Array(8, 14, 20, 7, 4, 6, 7)
RowArrQty = Array(9, 7, 15, 4, 17, 13, 13)
ColumArrName = Array(5, 9, 12, 5, 8, 9, 4)
RowArrName = Array(4, 14, 14, 17, 21, 16, 10)
For Seq = 0 To 6
    With Sheets(ShArr(Seq))
        DataRwCode = .Cells(1000000, ColumnArrCode(Seq)).End(xlUp).Row
        DataRwQty = .Cells(1000000, ColumnArrQty(Seq)).End(xlUp).Row
        DataRwName = .Cells(1000000, ColumArrName(Seq)).End(xlUp).Row
        StoreCode = .Range(.Cells(RowArrCode(Seq), ColumnArrCode(Seq)), _
        .Cells(DataRwCode, ColumnArrCode(Seq) + 1)).Value
        StoreQty = .Range(.Cells(RowArrQty(Seq), ColumnArrQty(Seq)), _
        .Cells(DataRwQty, ColumnArrQty(Seq) + 1)).Value
        ItemsName = .Range(.Cells(RowArrName(Seq), ColumArrName(Seq)), _
        .Cells(DataRwName, ColumArrName(Seq) + 1)).Value
         For i = 1 To UBound(StoreCode, 1)
                mc = StoreCode(i, 1): mq = StoreQty(i, 1): txt = Mid(mc, 1, 2): txt2 = Mid(mc, 3, 2)
                If (IsEmpty(mc) = False And Len(mc) = 4 And txt = "MH" And IsNumeric(txt2) = True _
                And IsEmpty(mq) = False And IsNumeric(mq) = True) Then
                    sKey = StoreCode(i, 1) & "|" & ItemsName(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
                End If
        Next
    End With
Next Seq
For i = 1 To Dict.Count
    Sheets("Data").Cells(i + 2, 2).Value = Split(Dict.keys()(i - 1), "|")(0)
    Sheets("Data").Cells(i + 2, 3).Value = Split(Dict.keys()(i - 1), "|")(1)
Next i
Sheets("Data").Range("B3:C" & Dict.Count).Sort [B3], xlAscending
With Sheets("Data")
SArr = .Range(.Cells(3, 2), .Cells(1000000, 3).End(xlUp)).Value
ReDim RArr(1 To UBound(SArr, 1), 1 To 1)
For i = 1 To UBound(SArr, 1)
    sKey = SArr(i, 1) & "|" & SArr(i, 2)
    If Dict.exists(SArr(i, 1) & "|" & SArr(i, 2)) Then
        RArr(i, 1) = Dict.Item(SArr(i, 1) & "|" & SArr(i, 2))
    Else
        RArr(i, 1) = 0
    End If
Next
.Range("D3").Resize(UBound(SArr, 1), 1) = RArr
End With
End Sub
 

File đính kèm

  • Dict_Exercise_9.xlsm
    1.4 MB · Đọc: 7
Lần chỉnh sửa cuối:
Upvote 0
Cô Bé Dễ Thương đã viết:
- Bài tập số 9 áp dụng Dictionary (cách đặt tên theo quy định)
Nhấp chuột vào đây để mở rộng...
Bài 147 có chữ nào hay câu nào không hiểu vậy?
Trích 147:
- Dùng 1 mảng kết quả song song với Dict, mảng này có thể có nhiều cột như Mã, Tên, SL. Số lượng không cộng dồn trên item của Dict mà cộng dồn trên cột SL của mảng kết quả. Cuối cùng đập 1 phát kết quả xuống sheet.

Không bao giờ xét cấu trúc mã. Mã nếu toàn ký tự chữ hay toàn ký số, hay mã dài 10 ký tự chữ và số lẫn lộn, lấy gì phân biệt
 
Upvote 0
ptm0412 đã viết:
Bài 147 có chữ nào hay câu nào không hiểu vậy?
Trích 147:
- Dùng 1 mảng kết quả song song với Dict, mảng này có thể có nhiều cột như Mã, Tên, SL. Số lượng không cộng dồn trên item của Dict mà cộng dồn trên cột SL của mảng kết quả. Cuối cùng đập 1 phát kết quả xuống sheet.

Không bao giờ xét cấu trúc mã. Mã nếu toàn ký tự chữ hay toàn ký số, hay mã dài 10 ký tự chữ và số lẫn lộn, lấy gì phân biệt
Nhấp chuột vào đây để mở rộng...
Vâng. Để ( ) nếu người nào bảo đặt tên kiểu giật gân, sợ bị nhòm nên có thòng câu đó vào cho chắc ạ.
Khi ngồi máy tính cháu chỉnh lại code. Cách chú bảo cháu không tưởng tượng ra. Với lại ham biểu diễn tý key chuỗi, mà cũng chưa có bài nào trong top áp dụng ạ (câu views ạ )
 
Lần chỉnh sửa cuối:
Upvote 0
Cô Bé Dễ Thương đã viết:
Vâng. Để ( ) nếu người nào bảo đặt tên kiểu giật gân, sợ bị nhòm nên có thòng câu đó vào cho chắc ạ.
Khi ngồi máy tính cháu chỉnh lại code. Cách chú bảo cháu không tưởng tượng ra. Với lại biểu diễn tý key chuỗi, nó ứng dụng cao ạ
Nhấp chuột vào đây để mở rộng...
Câu hỏi đơn giản vậy mà trả lời đâu đâu á. Câu sau đây, đọc chậm, đọc kỹ, và nhớ lại xem đã từng nói bao nhiêu lần, mà cứ tự làm theo ý mình?
Không bao giờ xét cấu trúc mã
Khi người dùng tự ý đặt mã và chấp nhận thêm mã của người ta thì xét làm gì? Thí dụ người ta đặt mã MaH105, một là thêm mã vào danh mục, hai là chấp nhận.
 
Upvote 0
ptm0412 đã viết:
Câu hỏi đơn giản vậy mà trả lời đâu đâu á. Câu sau đây, đọc chậm, đọc kỹ, và nhớ lại xem đã từng nói bao nhiêu lần, mà cứ tự làm theo ý mình?
Không bao giờ xét cấu trúc mã
Khi người dùng tự ý đặt mã và chấp nhận thêm mã của người ta thì xét làm gì? Thí dụ người ta đặt mã MaH105, một là thêm mã vào danh mục, hai là chấp nhận.
Nhấp chuột vào đây để mở rộng...
Dạ. Cháu sẽ sửa lại khi ngồi máy tính ạ. Chỉ để điều kiện Qty là không trống và là số là đc ạ
 
Upvote 0
Cô Bé Dễ Thương đã viết:
Dạ. Cháu sẽ sửa lại khi ngồi máy tính ạ. Chỉ để điều kiện Qty là không trống và là số là đc ạ
Nhấp chuột vào đây để mở rộng...
Nếu đang sửa thì làm 2 chuyện:
- Không xét cấu trúc mã
- Sử dụng 1 mảng kết quả 3 cột, bớt 1 vòng lặp for. Đọc lại câu: "Số lượng không cộng dồn trên item của Dict mà cộng dồn trên cột SL của mảng kết quả. Cuối cùng đập 1 phát kết quả xuống sheet."
Gợi ý:
- item của Dict là thứ tự dòng của mảng kết quả.
- Số dòng của mảng kết quả chưa biết thì khi Redim lấy tạm 2 lần số dòng của danh mục gốc với giả định là số mã tự ý đặt thêm không nhiều quá đến thế
 
Upvote 0
ptm0412 đã viết:
Nếu đang sửa thì làm 2 chuyện:
- Không xét cấu trúc mã
- Sử dụng 1 mảng kết quả 3 cột, bớt 1 vòng lặp for. Đọc lại câu: "Số lượng không cộng dồn trên item của Dict mà cộng dồn trên cột SL của mảng kết quả. Cuối cùng đập 1 phát kết quả xuống sheet."
Gợi ý:
- item của Dict là thứ tự dòng của mảng kết quả.
- Số dòng của mảng kết quả chưa biết thì khi Redim lấy tạm 2 lần số dòng của danh mục gốc với giả định là số mã tự ý đặt thêm không nhiều quá đến thế
Nhấp chuột vào đây để mở rộng...
PHP: 
...............................
sKey = StoreCode(i, 1)
If Not Dict.exists(sKey) Then
   j = j + 1
Dict.Add sKey, j
..............................
ReDim Res(1 to Dict.count, 1 to 3)
Rồi truyền sang mảng kết quả
Res(j,1) = sKey
Res(j,2) = ItemsName(i, 1)
Res(Dict.Item(sKey),3) = Res(Dict.Item(sKey),3) + StoreoQty(i, 1)
Cách này cháu làm hoài không được
Còn bài 9 cháu post lên: MH30 = Mặt hàng 29 hay là do dòng lệnh Sort chú nhỉ. Không sửa nổi, xin chú chỉ lỗi 2 cách cháu với!
Tại sao bài 9 cháu post lên lại có hiện tượng MH30 = Mặt hàng 29 vậy chú nhỉ (file dữ liệu 3 cột so le nhau đồng thời rồi ạ)
 
Lần chỉnh sửa cuối:
Upvote 0
Upvote 0
Cô Bé Dễ Thương đã viết:
- Nghĩa là cách làm key chuỗi đúng rồi ạ.
- Còn cách gán ra mảng kết quả Res nếu không phải tạo Key chuỗi thì làm sao dồn được cột Tên ạ?
Nhấp chuột vào đây để mở rộng...

Cô Bé Dễ Thương đã viết:
ReDim Res(1 to Dict.count, 1 to 3)
Rồi truyền sang mảng kết quả
Res(j,1) = sKey
Res(j,2) = ItemsName(i, 1)
Res(Dict.Item(sKey),3) = Res(Dict.Item(sKey),3) + StoreoQty(i, 1)
Nhấp chuột vào đây để mở rộng...


- Mảng kết quả song song Dict tức là chưa có Dict.Count, làm sao Redim Dict.Count được
- Nếu skey không tồn tại mới gán 3 cột kết quả, ngược lại sKey tồn tại thì cộng dồn. Thế mới là song song và loại bỏ vòng lặp. Code dưới đây 1 vòng lặp duy nhất chứ không phải 3
PHP: 
Sub Dict_Episode_9()
Dim DataRw As Long, sKey As String, Dict, RArr()
Dim ShArr, ColumnArrCode, RowArrCode, ColumnArrQty, RowArrQty, ColumnArrName, RowArrName
Dim DataRwCode As Long, DataRwQty As Long, DataRwName As Long
Dim StoreCode, StoreQty, ItemsName
Set Dict = CreateObject("Scripting.Dictionary")
ShArr = Array(2, 3, 4, 5, 6, 7, 8)
ColumnArrCode = Array(2, 4, 7, 3, 12, 12, 2)
RowArrCode = Array(7, 19, 10, 12, 11, 8, 6)
ColumnArrQty = Array(8, 14, 20, 7, 4, 6, 7)
RowArrQty = Array(9, 7, 15, 4, 17, 13, 13)
ColumArrName = Array(5, 9, 12, 5, 8, 9, 4)
RowArrName = Array(4, 14, 14, 17, 21, 16, 10)
ReDim RArr(1 To 100, 1 To 3)
For Seq = 0 To 6
    With Sheets(ShArr(Seq))
        DataRwCode = .Cells(1000000, ColumnArrCode(Seq)).End(xlUp).Row
        DataRwQty = .Cells(1000000, ColumnArrQty(Seq)).End(xlUp).Row
        DataRwName = .Cells(1000000, ColumArrName(Seq)).End(xlUp).Row
        StoreCode = .Range(.Cells(RowArrCode(Seq), ColumnArrCode(Seq)), _
        .Cells(DataRwCode, ColumnArrCode(Seq) + 1)).Value
        StoreQty = .Range(.Cells(RowArrQty(Seq), ColumnArrQty(Seq)), _
        .Cells(DataRwQty, ColumnArrQty(Seq) + 1)).Value
        ItemsName = .Range(.Cells(RowArrName(Seq), ColumArrName(Seq)), _
        .Cells(DataRwName, ColumArrName(Seq) + 1)).Value
         For i = 1 To UBound(StoreCode, 1)
                mc = StoreCode(i, 1): mq = StoreQty(i, 1)
                If IsEmpty(mc) = False And IsEmpty(mq) = False Then
                    sKey = StoreCode(i, 1)
                    If Not Dict.exists(sKey) Then
                        k = k + 1
                        Dict.Add sKey, k
                        RArr(k, 1) = sKey
                        RArr(k, 2) = ItemsName(i, 1)
                        RArr(k, 3) = StoreQty(i, 1)
                    Else
                        RArr(Dict.Item(sKey), 3) = RArr(Dict.Item(sKey), 3) + StoreQty(i, 1)
                    End If
                End If
        Next
    End With
Next Seq
With Sheets("Data")
    .Range("B3:D100").ClearContents
    .Range("B3").Resize(k, 3) = RArr
    .Range("B2").Resize(k + 1, 3).Sort Range("B2"), xlAscending, Header:=xlYes
End With
End Sub

1616170301375.png
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

huynhnhu1234
Tìm giá vé máy bay một chiều và khứ hồi
Trả lời
0
Đọc
10
huynhnhu1234
huynhnhu1234
B
Lọc dữ liệu trùng, đếm số lần, tự tô màu theo điều kiện.
Trả lời
1
Đọc
44
tranvansau278
T
P
Tổng hợp dữ liệu từ các sheet theo chọn lọc
Trả lời
11
Đọc
188
VetMini
V
V
[Nhờ giúp đỡ] Cách tìm thời gian bị trùng trong excel ở nhiều thời gian khác nhau
Trả lời
7
Đọc
107
tranvansau278
T
kimtanmap
  • Question
Nhờ viết code VBA Macro lập lại.
Trả lời
4
Đọc
95
Hoàng Tuấn 868
H
N
Hàm tìm giá trị theo giờ vào - ra
Trả lời
6
Đọc
98
Nguyễn Linh hn94
N
zarra
Cần giúp tạo form in mã vạch cho vật tư theo SL cụ thể.
Trả lời
4
Đọc
142
zarra
zarra
C
Chia sẻ: Kết quả xổ số Keno
    • Thích
Trả lời
2
Đọc
113
CHAOQUAY
C
Nguyễn Duy Tuân
  • Question
Chia sẻ ControlForOffice - Bộ công cụ điều khiển Office/Excel
    • Thích
6 7 8
Trả lời
148
Đọc
95K
leminhksvl
L
HeSanbi
  • Question
Lỗi VBA: Cài đặt thông số ForceVBALoadFromSource trong Registry để VBA biên dịch không bị lỗi
    • Cảm ơn
    • Thích
Trả lời
5
Đọc
286
anhdepjai
A
Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
Trả lời
16
Đọc
343
CHAOQUAY
C
H
Hàm đếm số ngày thứ bảy và chủ nhật trong một khoảng thời gian
Trả lời
18
Đọc
19K
DeTong
D
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
11 12 13
Trả lời
245
Đọc
13K
Hoàng Trọng Hữu
Hoàng Trọng Hữu
D
  • Question
Xin cách sắp xếp dữ liệu theo thứ tự không làm hỏng link
Trả lời
7
Đọc
294
cantl
C
N
Giúp sửa mã code
Trả lời
16
Đọc
265
ptm0412
ptm0412
dung09031989
Xin giúp công thức tô màu các ô phía sau khi kế hoạch đặt hàng thiếu so với tồn kho.?
Trả lời
0
Đọc
51
dung09031989
dung09031989
C
Công thức tự nhập liệu số lượng nhập khi bị âm
Trả lời
0
Đọc
53
cherry0187
C
N
Vẽ biểu đồ kết hợp nhiều yếu tố trong excel
Trả lời
1
Đọc
50
hoangminhtien
hoangminhtien
GPE-Trợ Lý
KHÓA HỌC BỨT PHÁ KỸ NĂNG EXCEL
    • Thích
Trả lời
0
Đọc
182
GPE-Trợ Lý
GPE-Trợ Lý
dunghtgiga
  • Đã khóa
Tính bốn tuần cho một tháng
Trả lời
9
Đọc
293
ptm0412
ptm0412
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom