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

Liên hệ QC
Hoàng Nhật Phương đã viết:
Con thử thấy lỗi "Invalid SQL statement; expected 'DELETE', 'INSERT', 'PROCEDURE', 'SELECT', or 'UPDATE'."
...
Nhấp chuột vào đây để mở rộng...
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'.
 
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'.
Nhấp chuột vào đây để mở rộng...
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.
 
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"
 
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

1687706462161.png

1687706495906.png

1687706528471.png
 

File đính kèm

  • NXT_SQL3.xlsm
    28.3 KB · Đọc: 13
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"
Nhấp chuột vào đây để mở rộng...
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
Nhấp chuột vào đây để mở rộng...
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 ạ.
 
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 ạ.
Nhấp chuột vào đây để mở rộng...
Ủ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
1687741884454.png
 
Lần chỉnh sửa cuối:
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 ạ.
Nhấp chuột vào đây để mở rộng...
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.
 
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
Nhấp chuột vào đây để mở rộng...
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.
Nhấp chuột vào đây để mở rộng...
À 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. :D
 
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.
Nhấp chuột vào đây để mở rộng...
Cả 3 thứ đều 1 nhát ra luôn mà? ngụy biện vừa thôi.
 
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

1687750640083.png
 

File đính kèm

  • NXT_SQL4.xlsm
    67.8 KB · Đọc: 10
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)

1687795334510.png

1687795369706.png


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:

1687795423336.png
 

File đính kèm

  • NXT_SQL4.xlsm
    85 KB · Đọc: 21
Lần chỉnh sửa cuối:
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
Nhấp chuột vào đây để mở rộ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
 
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:
Nhấp chuột vào đây để mở rộng...
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.
 
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
Nhấp chuột vào đây để mở rộng...
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
 
Lần chỉnh sửa cuối:
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 ạ!
 
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
Nhấp chuột vào đây để mở rộng...
Con cảm ơn bác đã tham gia, bác lại bị chú Mỹ lôi kéo rồi :yahoo:
 
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

S
  • Question
Không lấy đủ dữ liệu bằng kết nối ADO
Trả lời
5
Đọc
131
ongke0711
ongke0711
hung2412
  • Question
Có Code VBA nào để chỉnh Short date trong Control Panel không? (Ví dụ: Chỉnh dd/mm/yy => dd/mm/yyyy)
Trả lời
2
Đọc
20
ongke0711
ongke0711
H
Nhờ mấy anh chị giúp về công thức dò tìm kiếm và trả về kết quả ngày tháng
Trả lời
2
Đọc
30
SA_DQ
SA_DQ
Bich2B
lỗi định dạng ngày không đọc được công thức excel
Trả lời
7
Đọc
126
tijikama
tijikama
LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
2
Trả lời
35
Đọc
373
LuuAnh980
LuuAnh980
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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