Các bài tập VBA đơn giản dùng để xử lí CSDL (cơ sở dữ liệu) [Fần 3] (1 người xem)

[SA_DQ]

PHẦN GIỚI THIỆU​

Tạo 1 CSDL trong & xử lí nó để fục vụ cho công tác quản lí là nhu cầu có thực đang diễn ra hàng ngày tại các công sở, cơ quan sản xuất kinh doanh, dịch vụ,. . . .
Để tạo dựng nó ta cần thông qua các bước cơ bản sau đây:

Thiết kế: Tạo dựng các trang tính, bảng biểu,. . .

Vận hành: Gồm các công đoạn nhập dữ liệu, chỉnh sửa & làm ra các báo cáo tổng hợp hay chi tiết

Bảo trì & fát triển:

Đầu tiên xin giới thiệu đến các bạn 1 CSDL dùng để nhập hàng hóa từ nhà cung cấp;
Hiện tại trong file đính kèm ta chỉ có 3 trang tính.

Đó là trang "DMuc" sẽ gồm các bảng liệt kê hàng hóa. Thường nó có các trường sau: [TT], [Mã hàng], [Tên hàng], [Đơn vị tính], [Tồn Đầu],. . . .

Thứ đến là trang nhập dữ liệu
Trang này thường có hai fần; Mình tạm gọi là fần chung & fần chi tiết
Fần chung gồm các mục: Ngày tháng, Số fiếu, Nhà cung cấp, Mã NCC,. . . .
Fần chi tiết gồm các mục: [Mã hàng], [Tên hàng], [ĐVT], [Số lượng], [Ghi chú],. . .
Trang này dùng để nhập dữ liệu vô trang CSDL (mà trong file có tên là 'CTiet')

Trang chứa thông tin CSDL ('CTiet')
Trang này gồm 2 bảng; Một bảng chứa những dữ liệu có trong fần chung & 1 bảng chứa dữ liệu fần chi tiết bên trên ta vừa nêu
Một điều hết sức quan trọng là 2 bảng biểu này liên hệ khắng khít với nhau thông qua trường [Số fiếu]

Tác giả file này đã thiết lập qui trình để tạo ra số fiếu này. Chúng được tạo ra theo sự tăng dần của các ngày lập fiếu & trong 1 ngày thì tăng theo thứ tự của 3 kí số cuối.

Các bạn có thể tham khảo thêm các bài viết về CSDL trong excel có trên diễn đàn, chẳng hạn:
http://www.giaiphapexcel.com/forum/showthread.php?6159-Tạo-CSDL-trên-Excel
Nội dung bài tập đầu tiên sẽ có ở bài sau kế tiếp

Chúc vui & hạnh phúc!

 

[ChanhTQ@]

giả sử như mã phiếu không chứa thông điệp ngày trong nó thì chắc phải. . .

Nhưng thực tế nó đang chứa thông điệp về ngày-tháng-năm nhập hàng mà.
Rất mong bạn thực hiện í tưởng theo thông điệp này để cộng đồng chiêm ngưỡng.
Rất cảm ơn bạn trước!

 

[Vo Tinh]

Nhưng thực tế nó đang chứa thông điệp về ngày-tháng-năm nhập hàng mà.
Rất mong bạn thực hiện í tưởng theo thông điệp này để cộng đồng chiêm ngưỡng.
Rất cảm ơn bạn trước!

Từ bài của Bác SA đã học được thêm CurrentRegion
Nhận ra điều kiện lọc OR đơn giản, đằng này em cứ tìm điều kiện AND với mấy cái <,>,= nên chẳng ra được
Em làm Function TraMa() để trả từ Mã về Ngày và điền Ngày và STT vào BCao

Sub report()
Dim lastRow As Long, lastRow2 As Long, lastRow3 As Long, i As Long, myRg As Range, k As Long, j As Long
lastRow = Sheets("CTiet").Range("B" & Rows.Count).End(xlUp).Row
lastRow2 = Sheets("CTiet").Range("R" & Rows.Count).End(xlUp).Row
Set myRg = Sheets("CTiet").Range("B2:C" & lastRow)
Union(Sheets("BCao").[AA1].CurrentRegion.Offset(1, 0), Sheets("BCao").[B8].CurrentRegion.Offset(1, 0)).ClearContents
    For i = 1 To lastRow - 1
        If myRg.Cells(i, 1) >= Sheets("BCao").[C4] And myRg.Cells(i, 1) <= Sheets("BCao").[C5] Then
            k = k + 1
            Sheets("BCao").[AA1].Offset(k, 0) = myRg.Cells(i, 2)
        End If
    Next i
Sheets("CTiet").Range("R1:W" & lastRow2).AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("BCao").[AA1].CurrentRegion, CopyToRange:=Sheets("BCao").[C7:G7]
lastRow3 = Sheets("Bcao").Range("C" & Rows.Count).End(xlUp).Row
    For j = 1 To lastRow3 - 7
        Sheets("BCao").Range("A" & j + 7) = j
        Sheets("BCao").Range("B" & j + 7).FormulaR1C1 = "=trama(RC[1])"
    Next j
End Sub

Function TraMa(Optional Ma As String) As Date
Dim yR As Integer, Mth As Integer, Dy As Integer
Const StrC$ = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
yR = Application.WorksheetFunction.Find(Mid(Ma, 1, 1), StrC$, 1) + 2000
Mth = Application.WorksheetFunction.Find(Mid(Ma, 2, 1), StrC$, 1) - 1
Dy = Application.WorksheetFunction.Find(Mid(Ma, 3, 1), StrC$, 1) - 1
TraMa = Format(DateSerial(yR, Mth, Dy), "dd/MM/yyyy")
End Function

 

[doveandrose]

Nhưng thực tế nó đang chứa thông điệp về ngày-tháng-năm nhập hàng mà.
Rất mong bạn thực hiện í tưởng theo thông điệp này để cộng đồng chiêm ngưỡng.
Rất cảm ơn bạn trước!

làm vậy e không đúng với ý đồ của tác giả SA_DQ thôi chứ dùng filter chỉ 1 lần còn lẹ hơn

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngRS As Range, lr As Long, vungDK As Range, lrDT As Long, r As Long
Dim wsBC As Worksheet, wsCT As Worksheet


If Target.Address = "$C$4" Then Target.Offset(1).Value = Target.Value2
If Target.Address = "$C$5" Then
    Application.ScreenUpdating = False
    Set wsBC = Worksheets("BCao")
    Set wsCT = Worksheets("CTiet")


    With wsBC
        .[K1].Value = .[C7].Value
        .[L1].Value = .[C7].Value
        .[K2].Value = ">=" & TaoMa(.[C4].Value) & "N001"
        .[L2].Value = "<=" & TaoMa(.[C5].Value) & "N999"
        Set vungDK = .Range("K1:L2")
    End With
    With wsCT
        lr = WorksheetFunction.Max(.[B65000].End(xlUp).Row, 2)
        lrDT = WorksheetFunction.Max(.[R65000].End(xlUp).Row, 2)
        Worksheets("BCao").Range("A8:F" & (lrDT + 100)).ClearContents
        .Range("R1:W" & lrDT).AdvancedFilter CriteriaRange:=vungDK, Action:=xlFilterCopy, _
        CopyToRange:=wsBC.Range("C7:G7")
    End With
    
    With wsBC
        If .[C8].Value <> "" Then
            lrDT = .[C7].End(xlDown).Row
            .Range("B8:B" & lrDT).Formula = _
            "=OFFSET(CTiet!$B$1,MATCH(C8,CTiet!$C$2:$C$" & lr & ",0),0)"
            .Range("A8:A" & lrDT).Formula = "=row(A8)-7"
        End If
        .Range("K1:L2").ClearContents
    End With
    Application.ScreenUpdating = True
End If
End Sub

 

[SA_DQ]

Em làm Function TraMa() để trả từ Mã về Ngày và điền Ngày và STT vào BCao

Rất sáng tạo trong suy nghĩ!

(.) Trong VBA có hàm =InStr("ABC","B") => 2
(.) Câu lệnh này có thể cải biến để đỡ nặng máy:

Sheets("BCao").Range("B" & j + 7).FormulaR1C1 = "=trama(RC[1])"

Bằng cách iêu cầu hàm trả kết quả dưới dạng Value cho ô í luôn.

Rất mong bạn tiếp tục hưởng ứng topic này.

 

[Vo Tinh]

(.) Trong VBA có hàm =InStr("ABC","B") => 2
(.) Câu lệnh này có thể cải biến để đỡ nặng máy:

Sheets("BCao").Range("B" & j + 7).FormulaR1C1 = "=trama(RC[1])"

Bằng cách iêu cầu hàm trả kết quả dưới dạng Value cho ô í luôn.

Cám ơn Bác về hàm InStr(), thế mà em đi tìm hàm Find() trong VBA mà không có.
Để trả về Value thì em chỉ biết thêm 1 dòng lệnh này vào thôi

Sheets("BCao").Range("B" & j + 7).FormulaR1C1 = "=trama(RC[1])"
Sheets("BCao").Range("B" & j + 7) = Sheets("BCao").Range("B" & j + 7).Value

 

[Vo Tinh]

Bằng cách iêu cầu hàm trả kết quả dưới dạng Value cho ô í luôn.

Ah thì ra đặt hàm trong VBE thì trên sheet ra Value luôn

Sheets("BCao").Range("B" & j + 7) = TraMa(Sheets("BCao").Range("C" & j + 7))

Trong bài Anh doveandrose có điều kiện lọc là Mã, nhưng em không hiểu là Mã mà có thể so sánh lớn hơn, nhỏ hơn được ?

.[K2].Value = ">=" & TaoMa(.[C4].Value) & "N001"
.[L2].Value = "<=" & TaoMa(.[C5].Value) & "N999"

 

[SA_DQ]

Thực ra chúng ta đã xem xét 1 CSDL chưa thực lắm.

CSDL mà mấy lâu nay ta xem xét chỉ mới có khâu nhập, chưa có khâu xuất.
Nhưng vì loạt bài mới, sợ 1 số người thấy "to tác" quá, ít quan tậm nên mới vậy.
Dưới đây là 1 CSDL mới được chỉnh lại để chúng ta thực hành bài tập thứ 3:

Bài tập 3: Hãy lọc sản lượng nhập riêng 1 cột & xuất riêng 1 cột theo các ngày đã chỉ định. (Như trong trang tính 'BCao')

 

[doveandrose]

thầy ơi bài này code trong file luôn rồi . chắc có nhầm lẫn gì chăng ?

 

[SA_DQ]

thầy ơi bài này code trong file luôn rồi . chắc có nhầm lẫn gì chăng ?

Học viên này tấy mấy quá đó nha!

Cứ coi như đó là đáp án tồi đi vậy!

Rất mong các bạn tham gia giải theo các kiểu khác nữa như các bài trên nó; để cộng đồng có thêm nhiều tham khảo.

Rất cảm ơn bạn & mọi người!

 

[Vo Tinh]

Rất mong các bạn tham gia giải theo các kiểu khác nữa như các bài trên nó; để cộng đồng có thêm nhiều tham khảo.

Em đã chuyển sang CSDL mới
Em thêm 1 dòng lệnh vào macro cũ để có SL nhập

Sub report()
Dim lastRow As Long, lastRow2 As Long, lastRow3 As Long, sH As Worksheet, i As Long, myRg As Range, k As Long, j As Long
Set sH = ThisWorkbook.Worksheets("CTiet")
lastRow = sH.Range("B" & Rows.Count).End(xlUp).Row
lastRow2 = sH.Range("R" & Rows.Count).End(xlUp).Row
Set myRg = sH.Range("B2:C" & lastRow)
Union(Sheets("BCao").[AA1].CurrentRegion.Offset(1, 0), Sheets("BCao").[B9].CurrentRegion.Offset(2, 0)).ClearContents
    For i = 1 To lastRow - 1
        If myRg.Cells(i, 1) >= Sheets("BCao").[C4] And myRg.Cells(i, 1) <= Sheets("BCao").[C5] Then
            k = k + 1
            Sheets("BCao").[AA1].Offset(k, 0) = myRg.Cells(i, 2)
        End If
    Next i
Sheets("CTiet").Range("R1:W" & lastRow2).AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("BCao").[AA1].CurrentRegion, CopyToRange:=Sheets("BCao").[C8:F8], Unique:=False
With Sheets("Bcao")
lastRow3 = .Range("C" & Rows.Count).End(xlUp).Row
    For j = 1 To lastRow3 - 8
        .Range("A" & j + 8) = j
        .Range("B" & j + 8) = TraMa(.Range("C" & j + 8))
        If Mid(.Range("C" & j + 8), 4, 1) = "X" Then .Range("F" & j + 8).Cut .Range("G" & j + 8)
    Next j
End With
End Sub

 

[ChanhTQ@]

Em thêm 1 dòng lệnh vào macro cũ để có SL nhập

Sub report()
Dim lastRow As Long, lastRow2 As Long, lastRow3 As Long, sH As Worksheet, i As Long, myRg As Range, k As Long, j As Long
Set sH = ThisWorkbook.Worksheets("CTiet")
lastRow = sH.Range("B" & Rows.Count).End(xlUp).Row
lastRow2 = sH.Range("R" & Rows.Count).End(xlUp).Row
Set myRg = sH.Range("B2:C" & lastRow)
Union(Sheets("BCao").[AA1].CurrentRegion.Offset(1, 0), Sheets("BCao").[B9].CurrentRegion.Offset(2, 0)).ClearContents
    For i = 1 To lastRow - 1
        If myRg.Cells(i, 1) >= Sheets("BCao").[C4] And myRg.Cells(i, 1) <= Sheets("BCao").[C5] Then
            k = k + 1
            Sheets("BCao").[AA1].Offset(k, 0) = myRg.Cells(i, 2)
        End If
    Next i
Sheets("CTiet").Range("R1:W" & lastRow2).AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("BCao").[AA1].CurrentRegion, CopyToRange:=Sheets("BCao").[C8:F8], Unique:=False
With Sheets("Bcao")
lastRow3 = .Range("C" & Rows.Count).End(xlUp).Row
    For j = 1 To lastRow3 - 8
        .Range("A" & j + 8) = j
        .Range("B" & j + 8) = TraMa(.Range("C" & j + 8))
        If Mid(.Range("C" & j + 8), 4, 1) = "X" Then .Range("F" & j + 8).Cut .Range("G" & j + 8)
    Next j
End With
End Sub

Bạn đã gán bỡi lệnh: Set sH = ThisWorkbook.Worksheets("CTiet")
Thì câu lệnh

Sheets("CTiet").Range("R1:W" & lastRow2).AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("BCao").[AA1].CurrentRegion, CopyToRange:=Sheets("BCao").[C8:F8], Unique:=False

lí ra fải là khác đi 1 chút, còn như viết vậy bạn đang lãng fí chút nào đó 'tài nguyên' của bạn!

Thứ nhì: Nhìn vô macro của bạn có quá nhiều cụm từ "Sheets("BCao")."
Bạn hãy tìm cách chỉ xài cụm từ này 1 lần trong macro của mình thôi, cố gắng nha!

(húc thành công!

 

[SA_DQ]

Bài tập 4: Xây dựng thẻ kho mặt hàng

Theo mẫu có trong hình vẽ kèm theo

(húc nhiều thành công!

 

[ChanhTQ@]

Mình xin giới thiệu đến bạn Vo Tinh & vài các bạn khác một cách thức xài mảng đơn giản nhất có thể.
Để vậy ta tạm chia macro ở bài #30 ra làm ba công đoạn

CĐ1: Tạo dữ liệu cho vùng ‘Criteria’ để lọc
CĐ2: Chỉ là 1 dòng lệnh áp dụng fương thức AdvancedFilter
CĐ3: Điền dữ liệu ngày tháng tạo fiếu & số liệu xuất trong các fiếu & xóa số liệu xuất vừa lọc được

Sau CĐ2 ta có số liệu gần giống như trong hình ở bài #28 của Doveandrose
Khác ở chổ chưa có số liệu ngày ở vùng [B9:B22] & [G9:G22]
Chúng ta sẽ thực hiện đoạn macro xài mảng cho CĐ3 này:

 With Sheets("Bcao")
lastRow3 = .Range("C" & Rows.Count).End(xlUp).Row
    For j = 1 To lastRow3 - 8
        .Range("A" & j + 8) = j
        .Range("B" & j + 8) = TraMa(.Range("C" & j + 8))
        If Mid(.Range("C" & j + 8), 4, 1) = "X" Then .Range("F" & j + 8).Cut .Range("G" & j + 8)
    Next j
End With

Để việc chuyển biến này không choáng ngợp, ta tạm thời viết 1 macro khác; Sau khi viết xong ta vô hiệu hóa CĐ3 & thêm dòng lệnh triệu gọi macro vừa viết là được.

Macro mới có tên là Temp với nội dung như sau:

Sub Temp()
 Dim Rw%, J%, StrC$, Arr()
 
2 Rw = [c7].CurrentRegion.Rows.Count
 ReDim Arr(1 To Rw, 1 To 6)
 
4 Arr = [B9].Resize(Rw, 6).Value
 For J = 1 To UBound(Arr())
6    StrC = Arr(J, 2)
    Arr(J, 1) = GiaiMa(StrC)
8    If InStr(Arr(J, 2), "X") Then
        Arr(J, 6) = Arr(J, 5)
10        Arr(J, 5) = ""
    End If
12 Next J
 [B9].Resize(Rw, 6).Value = Arr()
End Sub

D1: Khai báo 4 biến để xài, trong đó 2 biến đầu ta đã quen; Biến StrC kiểu chuỗi & 1 mảng Arr()
D2: Lấy chỉ số dòng của vùng liên tục xung quanh [C7] đưa vô 1 biến số đã khai báo;
D3: Khai báo 1 biến mảng có số dòng bằng với số dòng dữ liệu vừa tìm, số cột là 6
D4: Ta đưa toàn bộ dữ liệu vùng mà CĐ2 vừa lọc được vô biến mảng.
Có điều cần chú í là cột ngày-tháng & cột ‘Xuất’ đang trống dữ liệu ta cũng đưa chúng vô mảng; 1 chàng thì đầu sông, 1 nàng thì cuối sông ( cột của mảng).

D5: Thiết lập vòng lặp từ 1 cho đến dòng cuối của chỉ số dòng của mảng Arr(); Thực ra ta có thể viết từ 1 cho đến Rw – là số dòng có dữ liệu của vùng. Vòng lặp này khi xong sẽ điền số liệu ngày vô cột ‘đầu sông’ & cột ‘cuối sông’ (xuất). Hơn nữa, chỉ điền cho ‘cuối sông’ khi trong chuỗi số fiếu có kí tự ‘X’
D6: Lấy giá trị thuộc cột thứ 2 của dòng đang khảo sát đưa vô biến chuỗi
D7: Điền ngày-tháng cho cột ‘đầu sông’
D8: Thiết lập điều kiện tìm số fiếu xuất; Điều kiện này kết thúc ở dòng D11
D9: Điền vô cột ‘cuối sông’ của mảng khi thỏa ĐK
D10: Xóa trị đã điền sang ‘cuối sông’ ở cột trái liện kề trong mảng.
D12: Kết thúc vòng lặp
D13: Ghi những gì trong mảng lên trang tính

Mong ít nhiều giúp bạn có khái niệm ban đầu hết sức nhỏ nhoi về xài mảng.

 

[doveandrose]

Theo mẫu có trong hình vẽ kèm theo

(húc nhiều thành công!

em xin chịu thua vì không biết lấy cái gì lắp vào ô F4 trong hình vẽ

 

[SA_DQ]

em xin chịu thua vì không biết lấy cái gì lắp vào ô F4 trong hình vẽ

Tồn đầu năm hiện trong file là bằng không. Còn muốn có cái số gì đó thì ta đến trang 'DMuc' & thêm vô [E1] tiêu đề là tồn đầu năm & giả lập số liệu kiểm kê cuối năm trước vô thôi.

Sau đó cũng như vài 3 ô khác trong hình ta VLOOKUP() mà thôi.

Chúc vui!

 

[Vo Tinh]

Tồn đầu năm hiện trong file là bằng không. Còn muốn có cái số gì đó thì ta đến trang 'DMuc' & thêm vô [E1] tiêu đề là tồn đầu năm & giả lập số liệu kiểm kê cuối năm trước vô thôi.
Sau đó cũng như vài 3 ô khác trong hình ta VLOOKUP() mà thôi.
Chúc vui!

Các cell phần trên của Thẻ Kho em dùng công thức Vlookup() lấy dữ liệu từ DMuc, thêm cột số liệu tồn kiểm kê vào DMuc.
Trong macro sẽ không làm các việc trên.
Cám ơn hướng dẫn các bước cơ bản Array của Bác, em đã tìm và học trên diễn đàn và cuối cùng cũng áp dụng vào macro của mình, có gì Bác và các AC hướng dẫn góp ý thêm

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [F3]) Is Nothing Then
    Dim lastRow As Long, i As Long, k As Long, myStr As String, sArr, rArr
    lastRow = Sheets("CTiet").[R1].CurrentRegion.Rows.Count
    ReDim sArr(1 To lastRow, 1 To 6)
    sArr = Sheets("CTiet").Range("R2:W" & lastRow)
    ReDim rArr(1 To UBound(sArr), 1 To 6)
        For i = 1 To lastRow - 1
            If sArr(i, 2) = [F3].Value Then
                k = k + 1
                myStr = sArr(i, 1) : rArr(k, 1) = k : rArr(k, 2) = TraMa(myStr) : rArr(k, 6) = sArr(i, 1)
                    If Mid(sArr(i, 1), 4, 1) = "N" Then
                        rArr(k, 3) = sArr(i, 5)
                    Else
                        rArr(k, 4) = sArr(i, 5)
                    End If
                        If k = 1 Then
                        rArr(k, 5) = [F4].Value + rArr(k, 3) - rArr(k, 4)
                        Else
                        rArr(k, 5) = rArr(k - 1, 5) + rArr(k, 3) - rArr(k, 4)
                        End If
            End If
        Next i
    [B7].CurrentRegion.Offset(1, 0).ClearContents
    [B7].Resize(lastRow, 6).Value = rArr
End If
End Sub

 

[SA_DQ]

1   [B7].CurrentRegion.Offset(1, 0).ClearContents
2    [B7].Resize(lastRow, 6).Value = rArr

Câu lệnh (1) nên để trước vòng lặp For . . . Next
Còn vì sao bạn thử tìm hiểu xem, 1 khi vòng lặp gặp gì đó bất thường.

(2) Nhiều nơi bên dưới biểu mẫu thẻ kho còn có 1 số dữ liệu bắt buộc fải có
Như

Mẫu số: S09-DNN
(Ban hành theo QĐ số: 48/2006/QĐ-BTC
ngày 14/9/2006 của Bộ trưởng BTC)

,. . . .
Vậy nên bạn nên mở volume (lastRow) vừa đủ nghe để khỏi ảnh hưởng đến hàng xóm!

 

[SA_DQ]

Bài tập 5: Báo cáo số liệu nhập xuất tồn trong kì.

Chúng ta cần tạo trang tính mới có nội dung như trong hình;
5 tiêu đề đầu của dòng 7 & số liệu dưới nó được chép từ 'DMuc' qua;
Nhiệm vụ bài này là điều đầy số liệu hoạt động của 'CTiet'
[Tồn ĐK]: Lượng nhập xuất từ đầu năm cho đến ngày đầu
[Nhập] & [Xuất] là lương nhập & xuất tương ứng trong kì đã định
[Tồn]: Ta có thể lắp bỡi công thức của Excel (hay tính trực tiếp trên VBA)

Chúc các bạn thành công.

 

[Vo Tinh]

Chúng ta cần tạo trang tính mới có nội dung như trong hình;
5 tiêu đề đầu của dòng 7 & số liệu dưới nó được chép từ 'DMuc' qua;
Nhiệm vụ bài này là điều đầy số liệu hoạt động của 'CTiet'
[Tồn ĐK]: Lượng nhập xuất từ đầu năm cho đến ngày đầu
[Nhập] & [Xuất] là lương nhập & xuất tương ứng trong kì đã định
[Tồn]: Ta có thể lắp bỡi công thức của Excel (hay tính trực tiếp trên VBA)

Chúc các bạn thành công.

Lòng vòng với mảng

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [C5]) Is Nothing Then
    Dim sh As Worksheet, lastRowCT As Long, lastRowDM As Integer, i As Long, j As Long, myStr As String, sArr, sArr2, rArr
    Dim startDay As Date, finishDay As Date, n As Single, x As Single, nt As Single, xt As Single
    Set sh = ThisWorkbook.Worksheets("CTiet")
    startDay = [C4].Value:    finishDay = [C5].Value
    lastRowCT = sh.[R1].CurrentRegion.Rows.Count
    lastRowDM = Sheets("DMuc").[A1].CurrentRegion.Rows.Count
    ReDim sArr(1 To lastRowCT, 1 To 6):    sArr = sh.Range("R2:W" & lastRowCT)
    ReDim sArr2(1 To lastRowDM - 1, 1 To 5):    sArr2 = Sheets("Dmuc").Range("A2:E" & lastRowDM)
    ReDim rArr(1 To lastRowDM - 1, 1 To 10)
    [A8].CurrentRegion.Offset(1, 0).ClearContents
    For i = 1 To lastRowDM - 1
        n = 0: nt = 0
        x = 0: xt = 0
        rArr(i, 1) = i
        rArr(i, 2) = sArr2(i, 2):        rArr(i, 3) = sArr2(i, 3)
        rArr(i, 4) = sArr2(i, 4):        rArr(i, 5) = sArr2(i, 5)
        For j = 1 To lastRowCT - 1
            myStr = sArr(j, 1)
            sArr(j, 6) = TraMa(myStr)
                If sArr(j, 6) >= startDay And sArr(j, 6) <= finishDay And sArr(j, 2) = sArr2(i, 2) Then
                    If Mid(sArr(j, 1), 4, 1) = "N" Then
                        n = n + sArr(j, 5)
                    ElseIf Mid(sArr(j, 1), 4, 1) = "X" Then
                        x = x + sArr(j, 5)
                    End If
                ElseIf sArr(j, 6) < startDay Or sArr(j, 6) > finishDay And sArr(j, 2) = sArr2(i, 2) Then
                    If Mid(sArr(j, 1), 4, 1) = "N" Then
                        nt = nt + sArr(j, 5)
                    ElseIf Mid(sArr(j, 1), 4, 1) = "X" Then
                        xt = xt + sArr(j, 5)
                    End If
                End If
        Next j
        rArr(i, 7) = n: rArr(i, 8) = x: rArr(i, 6) = rArr(i, 5) + nt - xt: rArr(i, 9) = rArr(i, 6) + n - x
    Next i
    [A8].Resize(lastRowDM - 1, 10).Value = rArr
End If
End Sub

Function TraMa(Optional Ma As String) As Date
Dim yR As Integer, Mth As Integer, Dy As Integer
Const StrC$ = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
yR = InStr(StrC, Mid(Ma, 1, 1)) + 2000
Mth = InStr(StrC, Mid(Ma, 2, 1)) - 1
Dy = InStr(StrC, Mid(Ma, 3, 1)) - 1
TraMa = Format(DateSerial(yR, Mth, Dy), "dd/MM/yyyy")
End Function

Vậy nên bạn nên mở volume (lastRow) vừa đủ nghe để khỏi ảnh hưởng đến hàng xóm!

Em đã chỉnh "volume" vừa đủ nghe ở bài trước. Thanks Bác SA

 

[SA_DQ]

Bạn nên tách ra làm 2 sự kiện.

Trong macro của bạn mình cho là có 2 sự kiện đan xen nhau.
Như mình thì mình sẽ tách ra làm 2:

1 sự kiện diễn ra khi kích hoạt trang tính

Private Sub Worksheet_Activate()
End Sub

Trong sự kiện này ta viết toàn bộ quá trình chép dữ liệu từ 'DMuc' sang 5 cột được tô vàng màu nền ở bài #39
Lí do ư: Trang danh mục này ít khi thay đổi nội dung; Nó tăng giảm loại mặt hàng không thể 1 sớm 1 chiều.
Nó thay đổi khi có biến động cônghệ, biến động lớn về nhà cung cấp ,. . .
Những biến động này rất lâu mới diễn ra một khi CQ đã đi vào hoạt động ổn định.
Nhưng macro của bạn thì lần chạy nào bạn cũng bắt nó làm đi làm lại những động tác tạm gọi là vô bổ đó! (đừng giận nha!)
Nêu chăng ta tách fần chép số liệu này ra riêng 1 macro

Như trên gợi í, chí ít bạn nên đưa vô thủ tục 'mở trang tính'

Macro còn lại chỉ là những việc:

(*) Tạo vòng lặp duyệt theo cột mã số mặt hàng (cột ) của trang 'NXT'

(*) Tiếp theo dò tìm trong vùng chi tiết của trang 'CTiet' xem dòng nào mà có mã hàng trùng với mã ta đang duyệt thì sử lí nó theo các hướng sau:
(+) Nếu có ngày bé hơn 'ngày đầu' ghi nối vô cột [G:G]
(Tất nhiên có công đoạn xét xem dòng đó là 'Nhập' hay 'Xuất'
Nếu 'Xuất' thì trừ đi, nếu 'Nhập' với số hiện có trong cột [G] cùng dòng mã hàng ta đang khảo sát.
Ta chép vô cột [G:G] chứ không chép vô cột [F]; Cột [F:f] ta lập công thức cộng 2 trị tồn đầu năm & tồn đầu kì lại với nhau.
Tất nhiên ta cho ẩn cột [G:G] đi khi báo cáo đã hoàn thiện.
(+) Còn ngày trong kỳ khảo sát (kì báo cáo) thì ta cộng thêm vô cột 'Nhập' hay 'Xuất' tương ứng theo kí tự thứ 4 trong mã fiếu.
Còn cột 'Tồn' ta sẽ lập 1 fép cộng đại số thôi.


Chia để trị dễ bảo trì hơn nhiều đó bạn!

Rất mong bạn thực hiện chu trình gợi í này. Lúc đó macro của bạn sẽ sáng sửa hơn là cái chắc.
Chúc bạn thành công mĩ mãn!