Truy vấn bằng SQL dữ liệu từ 2 bảng: bảng tồn và bảng nhập xuất

VetMini · 25/6/23

Hoàng Nhật Phương đã viết:
Con thử thấy lỗi "Invalid SQL statement; expected 'DELETE', 'INSERT', 'PROCEDURE', 'SELECT', or 'UPDATE'."
...

Xin lỗi, tôi gõ nhầm, mắt già kèm nhèm.
SELECT chứ không phải là Sectect

Cái lỗi nó báo có nghĩa là nó muốn đầu một câu truy vấn phải là một trong những từ khóa mà nó liệt ra: 'DELETE', 'INSERT', 'PROCEDURE', 'SELECT', 'UPDATE'.

Hoàng Nhật Phương · 25/6/23

VetMini đã viết:
Xin lỗi, tôi gõ nhầm, mắt già kèm nhèm.
SELECT chứ không phải là Sectect

Cái lỗi nó báo có nghĩa là nó muốn đầu một câu truy vấn phải là một trong những từ khóa mà nó liệt ra: 'DELETE', 'INSERT', 'PROCEDURE', 'SELECT', 'UPDATE'.

Vâng như vậy cũng giống lỗi câu lệnh trên rồi bác:
No value given for one or more required parameters.

VetMini · 25/6/23

Thớt này xcos đã mấy năm. Ngỡ giờ này bạn đã khá thành thạo cách debug SQL rồi.

Cách căn bản nhất là tách nhỏ dần.
Nếu câu trên vẫn lỗi thì thử:
" Select Data.*" & _
" FROM [NXT$G2:O29] Data"

ptm0412 · 25/6/23

Tốt nhất là không dùng SQL cho trường hợp này. Dùng 3 trường gộp lại thành 1 trường khóa cũng chỉ là chữa cháy công nghệ cao thôi, chứ không lấy được trường hợp có tồn nhưng không nhập xuất, hoặc trường hợp không tòn nhưng có nhập xuất. Lý do SQL chỉ có Left Join (lấy hết bên trái) hoặc Right Join (lấy hết bên phải), không có loại Full join (lấy hết 2 bên).

Cách thay thế thì tôi ưu tiên dùng Power query, nó có full join. Power query trong file đính kèm có thể lọc dữ liệu bao gồm nhiều mặt hàng, nhiều kho, chỉ cần chọn trong 2 ô J1 và J2 rồi refresh

Hoàng Nhật Phương · 26/6/23

VetMini đã viết:
Thớt này xcos đã mấy năm. Ngỡ giờ này bạn đã khá thành thạo cách debug SQL rồi.

Cách căn bản nhất là tách nhỏ dần.
Nếu câu trên vẫn lỗi thì thử:
" Select Data.*" & _
" FROM [NXT$G2:O29] Data"

ptm0412 đã viết:
Tốt nhất là không dùng SQL cho trường hợp này. Dùng 3 trường gộp lại thành 1 trường khóa cũng chỉ là chữa cháy công nghệ cao thôi, chứ không lấy được trường hợp có tồn nhưng không nhập xuất, hoặc trường hợp không tòn nhưng có nhập xuất. Lý do SQL chỉ có Left Join (lấy hết bên trái) hoặc Right Join (lấy hết bên phải), không có loại Full join (lấy hết 2 bên).

Cách thay thế thì tôi ưu tiên dùng Power query, nó có full join. Power query trong file đính kèm có thể lọc dữ liệu bao gồm nhiều mặt hàng, nhiều kho, chỉ cần chọn trong 2 ô J1 và J2 rồi refresh

View attachment 291946

View attachment 291947

View attachment 291948

Cảm ơn bác VetMini và chú Mỹ đã luôn giúp con.. vấn đề này cũng khá rắc rối với SQL. Còn với Power query thì con đã biết nó rất lợi hại nhưng do môi trường nhiều người dùng nên có lẽ con dùng vba để phù hợp với nhu cầu công việc của mình ạ.

xì tin · 26/6/23

Hoàng Nhật Phương đã viết:
Cảm ơn bạn đã giúp đỡ,
OT thử trường hợp này kết quả thấy khác với kết quả mong muốn.
Nhờ bạn kiểm tra giúp ạ.

Ủa câu lệnh mà mình viết nó ra kết quả đúng với kết quả bạn mong muốn mà?

Mã:

Sub TongHop()
    Dim strSQL As String
    strSQL = "Select Item,LotNo, StockNo,0 as OpeningStock,iif(StockType='IN',Quantity,0) as StockIn,iif(StockType='IN',0,Quantity) as StockOut From [NXT$G2:O] Union All Select Item,LotNo,StockNoTo,0,Quantity,0 From [NXT$G2:O] Where StockType Like 'MOV' Union All Select Item,LotNo,StockNo,Quantity,0,0 From [NXT$A2:E]"
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0 Xml;"
        Sheet3.Range("Y15").CopyFromRecordset .Execute("Select Item,LotNo,StockNo,Sum(OpeningStock) as OpeningStock,Sum(StockIn) as StockIn,Sum(StockOut) as StockOut,(Sum(OpeningStock)+Sum(StockIn)-Sum(StockOut)) as StockRemain From (" & strSQL & ") Where StockNo Like 'KHO_004' Group By Item,LotNo,StockNo")
    End With
End Sub

VetMini · 26/6/23

Hoàng Nhật Phương đã viết:
Cảm ơn bác VetMini và chú Mỹ đã luôn giúp con.. vấn đề này cũng khá rắc rối với SQL. Còn với Power query thì con đã biết nó rất lợi hại nhưng do môi trường nhiều người dùng nên có lẽ con dùng vba để phù hợp với nhu cầu công việc của mình ạ.

1. tôi không hiểu nổi. Môi trường nhiều người dùng mới là nơi tránh VBA. Bạn đưa người ta một file xlsm là người ta đã ngại. Chỉnh sửa xong người ta trả lại cũng file ấy, bạn cũng ngại. Bất cứ lúc nào cũng có thể nhiễm vi-rít.

2. muốn "dùng VBA để phù hợp" cũng chả sao. Nhưng có ai bắt buộc phải dùng ADODB? Cách thiết kế CSDL của bạn đã được phê rõ rệt là không phù hợp với truy vấn bằng SQL. Bạn đâu đến nổi tệ về Dictionary. Code theo chiều hướng đó dễ kiểm soát hơn.

Hoàng Nhật Phương · 26/6/23

xì tin đã viết:

Ủa câu lệnh mà mình viết nó ra kết quả đúng với kết quả bạn mong muốn mà?

Mã:

Sub TongHop()
    Dim strSQL As String
    strSQL = "Select Item,LotNo, StockNo,0 as OpeningStock,iif(StockType='IN',Quantity,0) as StockIn,iif(StockType='IN',0,Quantity) as StockOut From [NXT$G2:O] Union All Select Item,LotNo,StockNoTo,0,Quantity,0 From [NXT$G2:O] Where StockType Like 'MOV' Union All Select Item,LotNo,StockNo,Quantity,0,0 From [NXT$A2:E]"
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0 Xml;"
        Sheet3.Range("Y15").CopyFromRecordset .Execute("Select Item,LotNo,StockNo,Sum(OpeningStock) as OpeningStock,Sum(StockIn) as StockIn,Sum(StockOut) as StockOut,(Sum(OpeningStock)+Sum(StockIn)-Sum(StockOut)) as StockRemain From (" & strSQL & ") Where StockNo Like 'KHO_004' Group By Item,LotNo,StockNo")
    End With
End Sub

View attachment 291955

Cảm ơn bạn rất nhiều.

VetMini đã viết:
1. tôi không hiểu nổi. Môi trường nhiều người dùng mới là nơi tránh VBA. Bạn đưa người ta một file xlsm là người ta đã ngại. Chỉnh sửa xong người ta trả lại cũng file ấy, bạn cũng ngại. Bất cứ lúc nào cũng có thể nhiễm vi-rít.

2. muốn "dùng VBA để phù hợp" cũng chả sao. Nhưng có ai bắt buộc phải dùng ADODB? Cách thiết kế CSDL của bạn đã được phê rõ rệt là không phù hợp với truy vấn bằng SQL. Bạn đâu đến nổi tệ về Dictionary. Code theo chiều hướng đó dễ kiểm soát hơn.

À vì mọi người không phải ai cũng biết code hay Power query nên cứ muốn một nhát ra luôn đó bác.

ptm0412 · 26/6/23

Kể cả Power query vẫn bị rắc rối vì chỉ có thể xem từng kho một. Khi xem 2 kho 1 lúc trở lên thì các dòng kiểu MOV chỉ xuất hiện tại 1 trong 2 kho, vì không thể nhân bản. SQL lại càng không thể.
VBA Dict thì có thể nhưng phải 2 Dict, mục đích là vét hết dữ liệu của cả 2 bảng: tồn không nhập xuất và không tồn đầu nhưng có nhập xuất.
Cảm ơn bạn rất nhiều.

Hoàng Nhật Phương đã viết:
À vì mọi người không phải ai cũng biết code hay Power query nên cứ muốn một nhát ra luôn đó bác.

Cả 3 thứ đều 1 nhát ra luôn mà? ngụy biện vừa thôi.

ptm0412 · 26/6/23

Power query có thể xem cùng lúc chỉ 1 kho (ở J1), chọn mặt hàng ở J2 thì xem 1 mặt hàng, bỏ trống thì xem mọi mặt hàng

ptm0412 · 26/6/23

Này thì VBA, này thì Dict (chỉ 1 Dict)
Có thể xem 1 mặt hàng hoặc xem tất cả (điền M1 hoặc bỏ trống)

Có thể xem 1 kho hay nhiều kho (điền K1, K2, K3, ...)
Khi xem nhiều kho, loại MOV xuất hiện 2 dòng như hình:

Hoàng Nhật Phương · 27/6/23

ptm0412 đã viết:
Này thì VBA, này thì Dict (chỉ 1 Dict)
Có thể xem 1 mặt hàng hoặc xem tất cả (điền M1 hoặc bỏ trống)

View attachment 292015

View attachment 292016

Có thể xem 1 kho hay nhiều kho (điền K1, K2, K3, ...)
Khi xem nhiều kho, loại MOV xuất hiện 2 dòng như hình:

View attachment 292017

Quả thực chú Mỹ đã bắt đầu ngẫu hứng ahihi :yahoo:

ptm0412 · 27/6/23

Hoàng Nhật Phương đã viết:
Quả thực chú Mỹ đã bắt đầu ngẫu hứng ahihi

Chẳng qua là thấy ghét câu "một nhát ra luôn" mà cứ đòi SQL.
Với lại VBA kỳ này đố nhóc đọc hiểu, dù chỉ là dùng Dic và mảng

Hoàng Nhật Phương · 27/6/23

ptm0412 đã viết:
Chẳng qua là thấy ghét câu "một nhát ra luôn" mà cứ đòi SQL.
Với lại VBA kỳ này đố nhóc đọc hiểu, dù chỉ là dùng Dic và mảng

Giờ con mới xem code đúng là rất công phu chú ạ.
Tạm thời con nhờ anh 'rô bốt' dịch giúp đã ạ rồi sau khi có thời gian con nghiên cứu lại:

Mã:

Sub NXT()
    Dim DictTon As Object, DictNX As Object
    Dim IDKey As String, WH As String, Item As String
    Dim NextRw As Long, LastRw As Long, Rws As Long
    Dim ArrTon() As Variant, ArrNX() As Variant, ArrKq() As Variant, ArrKho() As Variant
    Dim ArrDItems As Variant, DItemi As Variant
    Dim j As Long, i As Long, k As Long, n As Long
    
    ' Tạo đối tượng từ lớp Dictionary để lưu trữ thông tin về tồn kho
    Set DictTon = CreateObject("Scripting.Dictionary")
    ' Tạo đối tượng từ lớp Dictionary để lưu trữ thông tin về nhận xuất
    Set DictNX = CreateObject("Scripting.Dictionary")
    
    Item = Sheet3.[M1] ' Lấy giá trị ô M1 trên Sheet3
    
    ' Xóa bộ lọc tự động trên Sheet "Ton"
    Sheets("Ton").AutoFilterMode = False
    LastRw = Sheets("Ton").[A10000].End(xlUp).Row ' Tìm dòng cuối cùng trong cột A trên Sheet "Ton"
    ArrTon = Sheets("Ton").Range("A2:D" & LastRw).Value ' Gán giá trị của vùng dữ liệu từ A2 đến D(LastRw) vào mảng ArrTon
    Rws = Rws + LastRw
    
    ' Xóa bộ lọc tự động trên Sheet "Data"
    Sheets("Data").AutoFilterMode = False
    LastRw = Sheets("Data").[A10000].End(xlUp).Row ' Tìm dòng cuối cùng trong cột A trên Sheet "Data"
    ArrNX = Sheets("Data").Range("A2:H" & LastRw).Value ' Gán giá trị của vùng dữ liệu từ A2 đến H(LastRw) vào mảng ArrNX
    Rws = Rws + LastRw
    
    LastRw = Sheet3.[K100].End(xlUp).Row ' Tìm dòng cuối cùng trong cột K trên Sheet3
    If LastRw > 1 Then
        ArrKho = Sheet3.Range("K1:K" & LastRw).Value ' Gán giá trị của vùng dữ liệu từ K1 đến K(LastRw) vào mảng ArrKho
    Else
        ReDim ArrKho(1 To 1, 1 To 1)
        ArrKho(1, 1) = Sheet3.[K1].Value ' Gán giá trị ô K1 trên Sheet3 vào mảng ArrKho
    End If
    
    Sheet3.[B4].Resize(10000, 7).Clear ' Xóa dữ liệu trong vùng từ ô B4 đến G10003 trên Sheet3
    
    For j = 1 To UBound(ArrKho, 1)
        WH = ArrKho(j, 1) ' Lấy giá trị từng phần tử trong mảng ArrKho
        
        ReDim ArrKq(1 To Rws, 1 To 7)
        
        ' Duyệt qua từng dòng trong mảng ArrTon
        For i = 1 To UBound(ArrTon, 1)
            ' Kiểm tra điều kiện để thêm dữ liệu vào Dictionary DictTon
            If Item = "" And ArrTon(i, 2) = WH Then
                k = k + 1
                ' Thêm dữ liệu vào Dictionary DictTon với key là sự kết hợp của cột A, cột B, cột C
                ' Value chứa số thứ tự, giá trị cột D và số thứ tự hàng
                DictTon.Add ArrTon(i, 1) & ArrTon(i, 2) & ArrTon(i, 3), k & "|" & ArrTon(i, 4) & "|" & i
            Else
                If ArrTon(i, 1) = Item And ArrTon(i, 2) = WH Then
                    k = k + 1
                    DictTon.Add ArrTon(i, 1) & ArrTon(i, 2) & ArrTon(i, 3), k & "|" & ArrTon(i, 4) & "|" & i
                End If
            End If
        Next
        
        K1 = DictTon.Count ' Số lượng phần tử trong Dictionary DictTon
        
        ' Duyệt qua từng dòng trong mảng ArrNX
        For i = 1 To UBound(ArrNX, 1)
            ' Kiểm tra điều kiện để tạo key và thêm dữ liệu vào Dictionary DictTon
            If (Item <> "" And ArrNX(i, 2) = Item And (ArrNX(i, 3) = WH Or ArrNX(i, 4) = WH)) Or Item = "" _
            And (ArrNX(i, 3) = WH Or ArrNX(i, 4) = WH) Then
                IDKey = ArrNX(i, 2) & WH & ArrNX(i, 7) ' Tạo key từ sự kết hợp của cột B, cột C và cột H
                ' Kiểm tra nếu key chưa tồn tại trong Dictionary DictTon
                If Not DictTon.exists(IDKey) Then
                    k = k + 1
                    DictTon.Add IDKey, k & "|" & 0
                End If
                n = Val(Split(DictTon.Item(IDKey), "|")(0)) ' Lấy số thứ tự từ value của key trong Dictionary DictTon
                ArrKq(n, 1) = ArrNX(i, 2)
                ArrKq(n, 2) = ArrNX(i, 7)
                ArrKq(n, 3) = WH
                ArrKq(n, 4) = Split(DictTon.Item(IDKey), "|")(1)
                ArrKq(n, 5) = ArrKq(n, 5) + IIf(ArrNX(i, 1) = "IN" Or ArrNX(i, 3) = WH, ArrNX(i, 8), 0)
                ArrKq(n, 6) = ArrKq(n, 6) + IIf(ArrNX(i, 1) = "OUT" Or (ArrNX(i, 1) = "MOV" And ArrNX(i, 4) = WH), ArrNX(i, 8), 0)
                ArrKq(n, 7) = ArrKq(n, 4) + ArrKq(n, 5) - ArrKq(n, 6)
                Debug.Print i, n, ArrKq(2, 6) ' In ra thông tin debug
            End If
        Next
        
        ArrDItems = DictTon.Items ' Gán các giá trị từ Dictionary DictTon vào mảng ArrDItems
        
        ' Duyệt qua từng dòng trong mảng ArrKq
        For i = 1 To k
            If ArrKq(i, 1) = "" Then
                DItemi = Split(ArrDItems(i - 1), "|") ' Tách các giá trị từ phần tử thứ (i-1) trong mảng ArrDItems
                ArrKq(i, 1) = ArrTon(DItemi(2), 1)
                ArrKq(i, 2) = ArrTon(DItemi(2), 3)
                ArrKq(i, 3) = WH
                ArrKq(i, 4) = DItemi(1)
                ArrKq(i, 5) = 0
                ArrKq(i, 6) = 0
                ArrKq(i, 7) = DItemi(1)
            End If
        Next
        
        NextRw = Sheet3.[B10000].End(xlUp).Row + 1 ' Tìm dòng cuối cùng trong cột B trên Sheet3 và tăng giá trị lên 1
        If k > 0 Then Sheet3.Cells(NextRw, 2).Resize(k, 7) = ArrKq ' Gán giá trị từ mảng ArrKq vào vùng dữ liệu trên Sheet3
        DictTon.RemoveAll ' Xóa tất cả phần tử trong Dictionary DictTon
        k = 0 ' Reset giá trị của biến k về 0
    Next
    
    Set DictTon = Nothing ' Gán giá trị Nothing cho đối tượng DictTon để giải phóng bộ nhớ
End Sub

befaint · 27/6/23

Hoàng Nhật Phương đã viết:
.AutoFilterMode = False

Nguyên tắc là không được xóa, làm mất cái xây dựng trên bảng tính. Chỉ được bỏ chọn lọc đi mà thôi.

Hoàng Nhật Phương đã viết:
[B4].Resize(10000, 7).Clear

Sẽ làm mất hết định dạng đã có và sẽ 'dính vết' tới vùng hết vùng đó => Nặng file.

ptm0412 · 27/6/23

Hoàng Nhật Phương đã viết:
Giờ con mới xem code đúng là rất công phu chú ạ.
Tạm thời con nhờ anh 'rô bốt' dịch giúp đã ạ rồi sau khi có thời gian con nghiên cứu lại:

Hiểu được câu lệnh mới là chuyện nhỏ. Chuyện lớn là các câu hỏi tại sao:
Tại sao tạo Dict từ bảng tồn, rồi tại sao lại bổ sung Dict từ bảng NX?
Tại sao điều kiện and or lắm thế?
Tại sao item của key trong Dict phải lấy 3 thành phần? Khi nào xài thành phần nào?
Tại sao thêm vòng lặp cuối?
Tại sao bỏ trống item lại có thể lấy hết?
Tại sao warehouse không bỏ trống để lấy hết?
Càng hỏi nhiều tại sao càng giỏi, chứ nhắm mắt chép về hiểu lơ mơ sau này làm sao tự viết.

HieuCD · 27/6/23

Hoàng Nhật Phương đã viết:

Cảm ơn chú Mỹ và bạn @xì tin đã quan tâm và góp ý.
Chú Mỹ giúp con câu lệnh hoàn chỉnh với, con loay hoay mãi rồi nhưng chưa được.
Nếu là VBA thì code sẽ như thế này ạ:

Mã:

Option Explicit

Sub testCalcInventory()

    Dim dic As Object, sheet As Worksheet
    Dim inventory As Variant, scan As Variant, result As Variant, Key As Variant
    Dim sPart As String, sLot As String, sTockNo As String, sTockNoTo As String, str As String, sTockNoSearch As String
    Dim i As Long, j As Long, r As Long, u As Long, k As Long
    Dim quantity As Double
    Dim c As Integer, style As String
 
    Const sDELIM As String = "|"
 
    Set sheet = ThisWorkbook.ActiveSheet
    inventory = sheet.Range("A3:E6").Value
    scan = sheet.Range("G3:O29").Value
 
    sTockNoSearch = "*KHO_004*"
 
    If IsArray(inventory) Then r = UBound(inventory, 1)
    If IsArray(scan) Then r = r + UBound(scan, 1)
 
    If (r = 0) Then
        Exit Sub
    End If
 
    If Not IsArray(scan) Then
        GoTo Iventory_
    End If
 
Scaner_:
 
    Set dic = CreateObject("Scripting.Dictionary")
    c = 8:     ReDim result(1 To r * 2, 1 To c)
 
    For i = LBound(scan, 1) To UBound(scan, 1)
    
        style = scan(i, 1)
        sPart = scan(i, 2)
        sTockNoTo = scan(i, 3)
        sTockNo = scan(i, 4)
        sLot = scan(i, 7)
        quantity = scan(i, 8)

        str = Join(Array(sPart, sTockNoTo, sLot), sDELIM)
        If Not dic.Exists(str) And (style = "MOV") Then
            If UCase(sTockNoTo) Like UCase(sTockNoSearch) Then
                k = k + 1
                dic.Add str, k
                result(k, 1) = k
                result(k, 2) = sPart
                result(k, 3) = sLot
                result(k, 4) = sTockNoTo
            End If
        End If
    
        Key = Join(Array(sPart, sTockNo, sLot), sDELIM)
        If Not dic.Exists(Key) Then
            If UCase(sTockNo) Like UCase(sTockNoSearch) Then
                k = k + 1
                dic.Add Key, k
                result(k, 1) = k
                result(k, 2) = sPart
                result(k, 3) = sLot
                result(k, 4) = sTockNo
            End If
        End If
    
        u = dic.Item(str):  r = dic.Item(Key)
    
        Select Case style
           Case "IN" 'NHAP KHO
                If (r > 0) Then result(r, 6) = result(r, 6) + quantity
                If (r > 0) Then result(r, 8) = result(r, 8) + quantity
           Case "OUT" 'XUAT KHO
                If (r > 0) Then result(r, 7) = result(r, 7) + quantity
                If (r > 0) Then result(r, 8) = result(r, 8) - quantity
           Case "MOV" 'CHUYEN KHO
                If (u > 0) Then result(u, 6) = result(u, 6) + quantity
                If (u > 0) Then result(u, 8) = result(u, 8) + quantity
                If (r > 0) Then result(r, 7) = result(r, 7) + quantity
                If (r > 0) Then result(r, 8) = result(r, 8) - quantity
        End Select
            
    Next i

    If Not IsArray(inventory) Then
        GoTo Result_
    End If
 
Iventory_:
    For i = LBound(inventory, 1) To UBound(inventory, 1)
        sPart = inventory(i, 1)
        sTockNo = inventory(i, 2)
        sLot = inventory(i, 3)
        quantity = inventory(i, 4)
        Key = Join(Array(sPart, sTockNo, sLot), sDELIM)
        str = Join(Array(sDELIM, sPart, sTockNo, sLot), sDELIM)
        If UCase(sTockNo) Like UCase(sTockNoSearch) Then
            If Not dic.Exists(Key) And (quantity > 0) Then
                k = k + 1
                dic.Add Key, k
                result(k, 1) = k
                result(k, 2) = sPart
                result(k, 3) = sLot
                result(k, 4) = sTockNo
                result(k, 5) = quantity
                result(k, 6) = quantity
            Else
                If Not dic.Exists(str) And (quantity > 0) Then
                    dic.Add str, quantity:  r = dic.Item(Key)
                    result(r, 5) = quantity
                    result(r, 8) = result(r, 5) + result(r, 6) - result(r, 7)
                End If
            End If
        End If
    Next i
 
Result_:
    If (k > 0) Then sheet.Range("P13").Resize(k, c).Value = result
 
End Sub

Rút gọn code lại

Mã:

Sub XYZ()
  Dim dic As Object, sh As Worksheet, aInve(), aScan(), res()
  Dim srI&, srD&, i&, k&, Q#, dau&
  Const kho$ = "*KHO_004*"
 
  Set sh = ThisWorkbook.ActiveSheet
  aInve = sh.Range("A3:E6").Value
  aScan = sh.Range("G3:O29").Value
  srI = UBound(aInve, 1): srD = UBound(aScan, 1)
  ReDim res(1 To srI + srD * 2, 1 To 8)
  Set dic = CreateObject("Scripting.Dictionary")
  For i = 1 To srI
    If aInve(i, 2) Like kho Then
      Call AddRes(dic, res, k, Array(aInve(i, 1), aInve(i, 3), aInve(i, 2)), aInve(i, 4), 5, 1)
    End If
  Next i
  For i = 1 To srD
    If aScan(i, 4) Like kho Then
      If aScan(i, 1) = "OUT" Then
        Call AddRes(dic, res, k, Array(aScan(i, 2), aScan(i, 7), aScan(i, 4)), aScan(i, 8), 7, -1)
      ElseIf aScan(i, 1) = "IN" Then
        Call AddRes(dic, res, k, Array(aScan(i, 2), aScan(i, 7), aScan(i, 4)), aScan(i, 8), 6, 1)
      Else
        Call AddRes(dic, res, k, Array(aScan(i, 2), aScan(i, 7), aScan(i, 4)), aScan(i, 8), 7, -1)
      End If
    ElseIf aScan(i, 3) Like kho Then
      Call AddRes(dic, res, k, Array(aScan(i, 2), aScan(i, 7), aScan(i, 3)), aScan(i, 8), 6, 1)
    End If
  Next i
  sh.Range("P13:W1000").ClearContents
  sh.Range("P13").Resize(k, 8) = res
End Sub

Private Sub AddRes(dic, res, k, ByVal arr, ByVal Q#, ByVal c&, ByVal DauTong&)
  Dim key$, ik&
  key = Join(arr, "|")
  If dic.exists(key) = False Then
    k = k + 1
    dic.Add key, k
    res(k, 1) = k
    res(k, 2) = arr(0)
    res(k, 3) = arr(1)
    res(k, 4) = arr(2)
  End If
  ik = dic(key)
  res(ik, c) = res(ik, c) + Q
  res(ik, 8) = res(ik, 8) + Q * DauTong
End Sub

hoalv1985 · 27/6/23

Anh chị cho em hỏi cách khắc phục lỗi:
Cannot update. Database or object read-only khi chạy câu lệnh sql
Em cảm ơn ạ!

Hoàng Nhật Phương · 27/6/23

HieuCD đã viết:

Rút gọn code lại

Mã:

Sub XYZ()
  Dim dic As Object, sh As Worksheet, aInve(), aScan(), res()
  Dim srI&, srD&, i&, k&, Q#, dau&
  Const kho$ = "*KHO_004*"
 
  Set sh = ThisWorkbook.ActiveSheet
  aInve = sh.Range("A3:E6").Value
  aScan = sh.Range("G3:O29").Value
  srI = UBound(aInve, 1): srD = UBound(aScan, 1)
  ReDim res(1 To srI + srD * 2, 1 To 8)
  Set dic = CreateObject("Scripting.Dictionary")
  For i = 1 To srI
    If aInve(i, 2) Like kho Then
      Call AddRes(dic, res, k, Array(aInve(i, 1), aInve(i, 3), aInve(i, 2)), aInve(i, 4), 5, 1, 1)
    End If
  Next i
  For i = 1 To srD
    If aScan(i, 4) Like kho Then
      If aScan(i, 1) = "OUT" Then
        Call AddRes(dic, res, k, Array(aScan(i, 2), aScan(i, 7), aScan(i, 4)), aScan(i, 8), 7, 1, -1)
      ElseIf aScan(i, 1) = "IN" Then
        Call AddRes(dic, res, k, Array(aScan(i, 2), aScan(i, 7), aScan(i, 4)), aScan(i, 8), 6, 1, 1)
      Else
        Call AddRes(dic, res, k, Array(aScan(i, 2), aScan(i, 7), aScan(i, 4)), aScan(i, 8), 6, 0, -1)
        Call AddRes(dic, res, k, Array(aScan(i, 2), aScan(i, 7), aScan(i, 4)), aScan(i, 8), 7, 1, 0)
      End If
    ElseIf aScan(i, 3) Like kho Then
      Call AddRes(dic, res, k, Array(aScan(i, 2), aScan(i, 7), aScan(i, 3)), aScan(i, 8), 6, 1, 1)
    End If
  Next i
  sh.Range("P13:W1000").Resize(k, 8).ClearContents
  sh.Range("P13").Resize(k, 8) = res
End Sub

Private Sub AddRes(dic, res, k, ByVal arr, ByVal Q#, ByVal c&, ByVal dau&, ByVal DauTong&)
  Dim key$, ik&
  key = Join(arr, "|")
  If dic.exists(key) = False Then
    k = k + 1
    dic.Add key, k
    res(k, 1) = k
    res(k, 2) = arr(0)
    res(k, 3) = arr(1)
    res(k, 4) = arr(2)
  End If
  ik = dic(key)
  res(ik, c) = res(ik, c) + Q * dau
  res(ik, 8) = res(ik, 8) + Q * DauTong
End Sub

Con cảm ơn bác đã tham gia, bác lại bị chú Mỹ lôi kéo rồi :yahoo:

HieuCD · 27/6/23

Hoàng Nhật Phương đã viết:
Con cảm ơn bác đã tham gia, bác lại bị chú Mỹ lôi kéo rồi

Thấy các code khá dài và khó kiểm soát điều kiện cộng trừ tồn kho nên rút gọn dể nhìn hơn
Code trên dư 1 dòng lệnh đã chỉnh lại

Truy vấn bằng SQL dữ liệu từ 2 bảng: bảng tồn và bảng nhập xuất

Ăn cùng góc phố

Thành viên gắn bó

Ăn cùng góc phố

Bad Excel Member

File đính kèm

Thành viên gắn bó

Thành viên chính thức

Ăn cùng góc phố

Thành viên gắn bó

Bad Excel Member

Bad Excel Member

File đính kèm

Bad Excel Member

File đính kèm

Thành viên gắn bó

Bad Excel Member

Thành viên gắn bó

|||||||||||||

Bad Excel Member

Chuyên gia GPE

Thành viên hoạt động

Thành viên gắn bó

Chuyên gia GPE

Đếm ngược thời gian