Gán dữ liệu từ sheet qua sheet (Phức tạp)

[othanhquango]

Chào các bạn. Mình có một vấn đề đâu đầu nhưng không có cách giải quyết. Nay nhờ các cao thủ VBA giúp mình.

Mình có file như đính kèm.
- Mình muốn khi sau khi nhập dữ liệu vào sheet Nhap, nhấn nút UPDATE CHI TIẾT thì tự động nó sẽ tìm đúng sheet cần gán và gán đúng vị trí (biết chiều dài <= 70m => Sheet ChiTiet_Hong, chiều dài >70m => sheet ChiTiet_Tot)
- Vấn đề thứ 2 như sau, phức tạp hơn cái thứ nhất (theo mình là vậy): sau khi nhập dữ liệu vào sheet Xuat nhấn nút UPDATE CHI TIẾT thì tự động nó sẽ tìm đúng sheet, và đúng vị trí của đoạn cần xóa => xóa.

Rất mong sự giúp đỡ của các cao thủ.
Chân thành cảm ơn các bạn.

 

[sealand]

Trước hết mình tham gia về cách tổ chức bảng biểu 1 chút:
1/Không có lý do gì bạn phải Merger cell cho nó mệt sử lý dữ liệu
2/Nên đưa thêm mã hàng vào tiêu đề cột vì tên hàng chẳng có gì liên quan đến bảng mã và dữ liệu nhập xuất cả
3/Cơ chế nhập xuất của bạn không hợp lý. Bạn nên để Nhập ghi (+) và xuất ghi (-) là hợp lý nhất. Thuận lợi cả việc tổng hợp NXT về sau (Mình thấy nếu xuất thì nhập ngược lại là xong và bỏ hamf ABS đi, như vậy số cuối lớn số đầu là phiếu nhập và số cuối nhỏ số đầu là phiếu xuất)

Bạn tham khảo file sửa theo ý kiển mình nha

 

[othanhquango]

Cảm ơn bạn về sự giúp đỡ. Mình tiếp thu ý kiến của bạn, và bỏ bớt 1 sheet. Giờ sheet nhập và xuất chung 1 sheet luôn.

Nhưng theo cơ chế của bạn, tồn kho sẽ có đoạn âm và đoạn dương => số tồn sẽ sai. Mà thực tế thì không thể để 1 đoạn có chiều dài âm được. Do đó mình có thêm 1 cột để chọn phát sinh khi gán. Chọn dấu (+): nhập, và (-) Xuất như vậy vẫn đáp ứng được theo yêu cầu của bạn và đỡ cho người dùng phải nhớ là số lớn trước hay số nhỏ trước.

Thứ 2: mình muốn lưu lại nhật ký nhập xuất, nên làm thêm khúc dưới của sheet. Sau khi gán các đoạn qua sheet tương ứng, đồng thời gán luôn những dòng đó xuống dưới, để biết sau này xem lại. Mình đã thiết kế lại sheet theo yêu cầu của bạn. Nhờ bạn tiếp tục nhận xét và giúp đỡ mình.

Àh, mình muốn bên sheet chi tiết chỉ còn những đoạn tồn hiện tại để tiện theo dõi. Tức là nếu nhập thêm => add thêm vô vị trí tương ứng, nếu xuất thì clear ra khỏi sheet chi tiết.

 

[sealand]

Trong hồ sơ cứ chiều dài + là nhập và chiều dài - là xuất rồi nên không cần cột loại phiếu nữa mà chỉ cần 1 ô xác định loại phiếu thôi
Mình sửa lại code, bạn tham khảo nha

 

[othanhquango]

Hic, hình như code của bạn có vấn đề thì phải. Mình nhập cùng mã hàng cùng chiều dài. Nhưng khi gán qua thì dòng đầu tiên có chiều dài, dòng 2 trở đi không có.

Vd:
- dòng 1: mã hàng abc, số đầu 10, số cuối 60
- dòng 2: cũng mã hàng abc, số đầu 60, số cuối 10.
=> gán qua sheet chi tiết.
thì bên sheet chi tiết có 2 dòng,
- dòng 1: số đầu, số cuối, chiều dài
- dòng 2 trở đi: số đầu, số cuối nhưng ko có chiều dài.

Thứ 2: hình như bạn chưa hiểu ý diễn đạt của mình. Mình muốn khi xuất => nhấn nút, tìm bên sheet chi tiết nếu có đoạn tương ứng => xóa đoạn đó đi, nếu không có đoạn tương ứng => báo lỗi. Chứ không phải như bạn là làm số âm, vì nếu vậy sheet chi tiết sẽ có đoạn âm (không hợp lý), thứ 2 rất nhiều đoạn => dữ liệu rất dài vì bên mình một công trình phát sinh rất nhiều.

Kính mong bạn và các cao thủ của GPE hỗ trợ mình vấn đề phức tạp này.

 

[sealand]

Bạn chép code Nap() sau vào và xóa đoạn cũ đi nha

Sub Nap(ByRef Ng As Range, ByRef Di As Range)
Dim iR
iR = Sheet5.[H65536].End(3).Row + 1
Di.End(xlDown).Offset(1) = Ng.Offset(, -2).Value
Di.End(xlDown).Offset(, 1) = Ng.Offset(, -1).Value
Di.End(xlDown).Offset(, 2) = (Ng.Offset(, -1).Value - _
Ng.Offset(, -2).Value) * IIf(Sheet5.[C1] = "PN", 1, -1)
Sheet5.Rows(iR).Value = Sheet5.Rows(Ng.Row).Value
Sheet5.Cells(iR, "G").Value = Sheet5.Cells(iR, "G").Value _
* IIf(Sheet5.[C1] = "PN", 1, -1)
Ng.Offset(, -6).Resize(, 3).Value = ""
Ng.Offset(, -2).Resize(, 2).Value = ""
End Sub

 

[othanhquango]

Hic, nói sao đây nhỉ, biết là làm phiền bạn lắm nhưng nhờ bạn cố gắng giúp dùm mình. Tại vì cái này làm tay vất vả và dễ nhầm lắm.

File của bạn mình test thì thấy như sau:
VD:
- Khi mình chọn phiếu nhập:
1 đoạn 00 - 80, 1 đoạn 80 - 00, như vậy sau khi mình gán vô, thực tế là nhập 2 đoạn và số tồn phải là 160m, nhưng theo bạn thì gán 1 cái +80m, 1 cái -80m => số tồn =0 (đó là lý do mình dùng abs và không thích có đoạn âm trong tồn chi tiết).
- Trường hợp xuất cũng tương tự.

Do nhu cầu công việc đòi hỏi độ chính xác tuyệt đối => nên mình hạn chế làm tay, sai cái là số tiền dễ lên hàng trăm triệu => đi bộ đội liền. Do đó rất mong sự giúp đỡ của bạn sealand và anh em của GPE. Nhờ các cao thủ nhúng tay giúp mình.

Chân thành cảm ơn.

 

[sealand]

Mình đè nghị bạn nên có 1 số lượng nhất định số liệu để Demo báo cáo và tổng hợp số liệu. Mình chả hiểu sao bạn nhập phiếu nhập lại ra số âm cả. Nói thực, cái này làm ít thì được chứ làm nhiều vật tư chắc oải quá. Gia sử có 300 mặt hàng thì Exc 2003 đã chết ngắc rồi. Lấy đâu 300 x 3 cột cho sheet data đây.
Còn vấn đề bạn yêu cầu mình sẽ xem lại và hợp tác để bạn toại ý.

 

[othanhquango]

Mình up lại file và có diễn giải chi tiết trong file. Nhờ bạn giúp đỡ mình.

Có thể cách mình thiết kế csdl chưa hợp lý, bạn có thể giúp mình tổ chức lại cũng được nhưng phải đảm bảo yêu cầu:
- Quản lý cả tốt và hỏng
- Xem được số tồn cả tốt và hỏng.
- Xem được chi tiết tồn kho hiện tại bao gồm những đoạn nào, chi tiết của từng đoạn (bao gồm đoạn nào, số đầu, số cuối, số mét bao nhiu)
- Xem công trình xyz xuất những đoạn nào (chi tiết), nhập những đoạn nào (chi tiết).

 

[sealand]

Mình thực hiện việc chép dữ liệu giùm bạn còn cách tính toán thế nào tuỳ bạn.

Option Explicit
Sub nhap()
Dim rg As Range, Dich As Range
For Each rg In Ps.Range("g5:g19")
If rg.Value > 70 Then
Set Dich = Tot.Rows(1).Find(what:=rg.Offset(, -4))
If Not Dich Is Nothing Then Nap rg, Dich
ElseIf rg.Value > 0 Then
Set Dich = Hg.Rows(1).Find(what:=rg.Offset(, -4))
If Not Dich Is Nothing Then Nap rg, Dich
End If
Next
End Sub
'**************************************
Sub Nap(ByRef Ng As Range, ByRef Di As Range)
Dim iR
iR = Sav.[H65536].End(3).Row + 1
Di.End(xlDown).Offset(1) = Ng.Offset(, -2).Value
Di.End(xlDown).Offset(, 1) = Ng.Offset(, -1).Value
Sav.Cells(iR, 1) = Ng.Offset(, -6)
Sav.Cells(iR, 2) = Ng.Offset(, -5)
Sav.Cells(iR, "C").Value = Ps.[C1].Value
Sav.Range(Sav.Cells(iR, "D"), Sav.Cells(iR, "K")).Value _
= Ng.Offset(, -4).Resize(, 9).Value
Ng.Offset(, -6).Resize(, 3).Value = ""
Ng.Offset(, -2).Resize(, 2).Value = ""
Ng.Offset(, 2).Resize(, 3).Value = ""
End Sub

 

[othanhquango]

Tuyệt vời, rất đúng ý mình.
Nhập tương đối OK, bạn sửa lại giúp mình là điều kiện để gán vô sheet chi tiết tốt hay sheet chi tiết hỏng là dựa vào cột trạng thái, chứ bạn đừng dựa vào chiều dài. Vì 02 lý do:
- Hiện tại theo quy định là 70m, nhưng sau này có thể thay đổi.
- Có một số đoạn dù trên 70m nhưng vẫn phải nhập vô kho hỏng vì không tái sử dụng được (vd xướt hay hở đồng ở giữa.)
Còn lại thì OK về phần nhập.

Xuất thì có vấn đề, xuất mà cũng gán vô tồn chi tiết giống nhập, hic => Xuất đi thay vì số tồn phải giảm lượng a, giờ lại tăng lên 1 lượng a.
Mình muốn khi xuất:
- Nếu đánh số đầu, số cuối của đoạn nào đó vô, nếu số tồn bên chi tiết có đúng đoạn đó thì xóa bên tồn chi tiết đoạn tương ứng. Nếu không có => báo msgbox

- Khi gán qua sheet NKPS bạn gán thiếu cột Ghi chú.
Rất cảm ơn bạn, mình test thì thấy rất hợp ý mình. Còn phần Xuất khó hơn và một số vấn đề của phần nhập nữa, nhờ bạn hỗ trợ giúp.
Một lần nữa chân thành cảm ơn bạn.

 

[sealand]

Bạn thay code nhap như sau:

Sub nhap()
Dim rg As Range, Dich As Range
For Each rg In Ps.Range("g5:g19")
If rg.Offset(, 1).Value = "Tot" Then
Set Dich = Tot.Rows(1).Find(what:=rg.Offset(, -4))
If Not Dich Is Nothing Then Nap rg, Dich
ElseIf rg.Offset(, 1).Value = "Hong" Then
Set Dich = Hg.Rows(1).Find(what:=rg.Offset(, -4))
If Not Dich Is Nothing Then Nap rg, Dich
End If
Next
End Sub

Mình đã nói là cơ chế nhập xuất giống nhau của bạn sớm muộn cũng nảy vấn đề. Cơ chế tìm trừ của bạn cũng rất rắc rối, mình tham gia bạn nên nghiên cứu trước khi đi sâu vào hướng này.

 

[othanhquango]

Bạn xem lại giúp mình, sao lần đầu tiên nhập. Nó luôn luôn, xóa dữ liệu ô D3 sheet ChiTiet_Hong, ghi chú cũng không được gán qua sheet NKPS.

Hic, biết thế nên mình mới để chữ phức tạp ở tiêu đề topic đó chứ. Có cách thiết kế cơ sở dữ liệu khác mà vẫn đảm bảo yêu cầu mình đưa ra thì cũng được. Vậy phương án xuất thì xử lý thế nào được nhỉ? Các cao thủ GPE sao không thèm ngó gì tới topic này vậy trời.

Nếu vấn đề xuất không giải quyết được thì đành làm tay vậy. Hic hic. Mình có một ý tưởng là khi xuất thì sử dụng listbox hay valuelist gì đó, cho chọn trực tiếp các đoạn đang tồn luôn. Sau đó sử dụng đoạn đó đồng thời xóa đoạn tương ứng trong kho cũng clear luôn.

 

[concogia]

Bạn gán code này vào nút, chạy thử rồi kiểm tra xem:

Public Sub HicHic()
Dim Vung, wHome, wTot, wHong, wNKPS, Mg(), iHang, dHome, kK, I, mM, Ws, VungTot, iCot, DoXoa, Cll, d, Tam, nN, SoHang, J, Sl
Set dHome = CreateObject("scripting.dictionary"): Set d = CreateObject("scripting.dictionary")
Set wHome = Sheets("Home"): Set wTot = Sheets("chitiet_tot"): Set wHong = Sheets("chitiet_hong"): Set wNKPS = Sheets("NKPS")
Set Vung = Range([a5], [a100].End(xlUp))
Set VungTot = wTot.Range(wTot.[a1], wTot.[cc1].End(xlToLeft))
    For I = 1 To Vung.Rows.Count
        iCot = Application.WorksheetFunction.Match(Vung(I).Offset(, 2), VungTot, 0)
            If [c1] = "Nhap" Then
                Sheets("chitiet_" & Vung(I).Offset(, 7).Value).Cells(1000, iCot).End(xlUp)(2).Resize(, 3).Value = Vung(I).Offset(, 4).Resize(, 3).Value
            Else
                Set Ws = Sheets("chitiet_" & Vung(I).Offset(, 7).Value)
                Set DoXoa = Ws.Range(Ws.Cells(3, iCot), Ws.Cells(1000, iCot).End(xlUp))
                nN = 1
                    For Each Cll In DoXoa
                    Tam = Cll & Cll.Offset(, 1)
                    If Not d.exists(Tam) Then
                    d.Add Tam, nN
                    nN = nN + 1
                    End If
                    Next Cll
                        If d.exists(Vung(I).Offset(, 4) & Vung(I).Offset(, 5)) Then
                            SoHang = d.Item(Vung(I).Offset(, 4) & Vung(I).Offset(, 5))
                            DoXoa(SoHang).Resize(, 3).Delete Shift:=xlUp
                            Exit For
                        Else
                            MsgBox "Không có khúc: " & Vung(I).Offset(, 4) & "- " & Vung(I).Offset(, 5)
                            Exit Sub
                        End If
            End If
    Next I
        wNKPS.[a20000].End(xlUp)(2).Resize(Vung.Rows.Count, 2).Value = Vung.Resize(Vung.Rows.Count, 2).Value
        wNKPS.[c20000].End(xlUp)(2).Resize(Vung.Rows.Count).Value = [c1]
        wNKPS.[d20000].End(xlUp)(2).Resize(Vung.Rows.Count, 9).Value = Vung.Offset(, 2).Resize(Vung.Rows.Count, 9).Value
            Set iHang = wHome.Range(wHome.[a7], wHome.[a100].End(xlUp))
            ReDim Mg(1 To iHang.Rows.Count, 1 To 6)
            Mg = wHome.Range(wHome.[a7], wHome.[a100].End(xlUp)).Resize(, 6).Value
            kK = 1
                For I = 1 To iHang.Rows.Count
                    If Not dHome.exists(iHang(I).Value) Then
                        dHome.Add iHang(I).Value, kK
                    End If
                        kK = kK + 1
                Next I
                    For I = 1 To Vung.Rows.Count
                        mM = dHome.Item(Vung(I).Offset(, 2).Value)
                            If [c1] = "Nhap" And Vung(I).Offset(, 7) = "Tot" Then
                                Mg(mM, 5) = Mg(mM, 5) + Vung(I).Offset(, 6).Value
                            ElseIf [c1] = "Nhap" And Vung(I).Offset(, 7) = "Hong" Then
                                Mg(mM, 4) = Mg(mM, 4) + Vung(I).Offset(, 6)
                            ElseIf [c1] = "Xuat" And Vung(I).Offset(, 7) = "Tot" Then
                                Mg(mM, 5) = Mg(mM, 5) - Vung(I).Offset(, 6)
                            Else
                                Mg(mM, 4) = Mg(mM, 4) - Vung(I).Offset(, 6)
                            End If
                    Next I
                            wHome.[a7].Resize(iHang.Rows.Count, 6) = Mg
    Union(Vung.Resize(, 3), Vung.Offset(, 4).Resize(, 2), Vung.Offset(, 8).Resize(, 3)).ClearContents
End Sub

Bài này quá phức tạp, thử 2, 3 lần cũng chẳng biết trúng trật nữa ( dễ tẩu hỏa nhập ma lắm), nếu là xuất mà không có khúc đó nó sẽ báo và thoát thủ tục luôn nhé bạn
Dữ liệu ở C1 là "Nhap" hay "Xuat" ( không dấu) nhé bạn
Híc, viết xong rồi muốn làm gọn code lại cũng chẳng biết đường nào mà mò nữa, rõ chán

 

[othanhquango]

Haha, thêm một cao thủ nữa giúp mình rồi. Mừng quá, để mình test thử. Chính vì vậy nên mình mới để chữ phức tạp ở topic đó chứ. Làm tay còn dễ điên mà.

Sau khi test, mình thấy như sau:
- Nhập, là ok. Đúng ý mình
- Xuất bị lỗi:
+ Nếu nhập lớn hơn 1 đoạn => chỉ xóa đoạn đầu tiên bên sheet chi tiết, từ đoạn thứ 2 trở đi không xóa.
+ Nếu nhập đoạn đầu tiên không đúng (tức là không có trong kho) => báo lỗi và dừng các đoạn tiếp theo (khúc này ok). Nhưng nếu đoạn đầu tiên đúng (tức là có trong kho) thì chỉ xóa duy nhất đoạn đầu tiên bên sheet chi tiết còn từ đoạn thứ 2 trở đi không làm gì cả, không xóa bên sheet chi tiết. Ngay cả đoạn thứ 2 trở đi có trong kho hay không cũng không kiểm tra => không báo lỗi.
+ Thêm 1 vấn để nho nhỏ, fix được thì tốt luôn. Đó là giả sử trong kho có đoạn 00-100 chẳng hạn, nhưng khi xuất người dùng nhập 100-00 thì cũng báo là không có. Nếu như có thể kiểm trả chéo và vẫn chấp nhận trong trường hợp này thì hay quá. Mình nghĩ để hạn chế trường hợp này sao ta không làm thế này: ngay từ đầu trước khi gán nhập, ta đảo số trước rồi mới gán, và trước khi xuất ta cũng đảo số trước rồi mới tìm. Cho số đầu luôn luôn là số nhỏ hơn và số cuối luôn luôn là số lớn hơn chẳng hạn.

Rất chân thành cảm ơn sự giúp đỡ của các bạn. Mong các bạn tiếp tục hỗ trợ mình.

 

[concogia]

Haha, thêm một cao thủ nữa giúp mình rồi. Mừng quá, để mình test thử. Chính vì vậy nên mình mới để chữ phức tạp ở topic đó chứ. Làm tay còn dễ điên mà.

Sau khi test, mình thấy như sau:
- Nhập, là ok. Đúng ý mình
- Xuất bị lỗi:
+ Nếu nhập lớn hơn 1 đoạn => chỉ xóa đoạn đầu tiên bên sheet chi tiết, từ đoạn thứ 2 trở đi không xóa.
+ Nếu nhập đoạn đầu tiên không đúng (tức là không có trong kho) => báo lỗi và dừng các đoạn tiếp theo (khúc này ok). Nhưng nếu đoạn đầu tiên đúng (tức là có trong kho) thì chỉ xóa duy nhất đoạn đầu tiên bên sheet chi tiết còn từ đoạn thứ 2 trở đi không làm gì cả, không xóa bên sheet chi tiết. Ngay cả đoạn thứ 2 trở đi có trong kho hay không cũng không kiểm tra => không báo lỗi.
+ Thêm 1 vấn để nho nhỏ, fix được thì tốt luôn. Đó là giả sử trong kho có đoạn 00-100 chẳng hạn, nhưng khi xuất người dùng nhập 100-00 thì cũng báo là không có. Nếu như có thể kiểm trả chéo và vẫn chấp nhận trong trường hợp này thì hay quá. Mình nghĩ để hạn chế trường hợp này sao ta không làm thế này: ngay từ đầu trước khi gán nhập, ta đảo số trước rồi mới gán, và trước khi xuất ta cũng đảo số trước rồi mới tìm. Cho số đầu luôn luôn là số nhỏ hơn và số cuối luôn luôn là số lớn hơn chẳng hạn.

Rất chân thành cảm ơn sự giúp đỡ của các bạn. Mong các bạn tiếp tục hỗ trợ mình.

Thử cái này xem

Public Sub HicHicHic()
Dim Vung, wHome, wTot, wHong, wNKPS, Mg(), iHang, dHome, kK, I, mM, Ws, VungTot, iCot, DoXoa, Cll, d, Tam, nN, SoHang, J, Sl
Set dHome = CreateObject("scripting.dictionary"): Set d = CreateObject("scripting.dictionary")
Set wHome = Sheets("Home"): Set wTot = Sheets("chitiet_tot"): Set wHong = Sheets("chitiet_hong"): Set wNKPS = Sheets("NKPS")
Set Vung = Range([a5], [a100].End(xlUp))
Set VungTot = wTot.Range(wTot.[a1], wTot.[cc1].End(xlToLeft))
    For I = 1 To Vung.Rows.Count
        iCot = Application.WorksheetFunction.Match(Vung(I).Offset(, 2), VungTot, 0)
            If [c1] = "Nhap" Then
                Sheets("chitiet_" & Vung(I).Offset(, 7).Value).Cells(1000, iCot).End(xlUp)(2).Resize(, 3).Value = Vung(I).Offset(, 4).Resize(, 3).Value
            Else
                Set Ws = Sheets("chitiet_" & Vung(I).Offset(, 7).Value)
                Set DoXoa = Ws.Range(Ws.Cells(1, iCot), Ws.Cells(1000, iCot).End(xlUp))
                If DoXoa.Rows.Count = 2 Then MsgBox "Dêch còn khúc nào có mã: " & Ws.Cells(1, iCot)
                    For J = 3 To DoXoa.Rows.Count
                        If Vung(I).Offset(, 4) & Vung(I).Offset(, 5) = DoXoa(J) & DoXoa(J).Offset(, 1) Then
                            DoXoa(J).Resize(, 3).Delete Shift:=xlUp
                            Exit For
                        ElseIf J = DoXoa.Rows.Count Then MsgBox " Không có khúc: " & Vung(I).Offset(, 4) & "- " & Vung(I).Offset(, 5)
                        End If
                    Next J
            End If
    Next I
        wNKPS.[a20000].End(xlUp)(2).Resize(Vung.Rows.Count, 2).Value = Vung.Resize(Vung.Rows.Count, 2).Value
        wNKPS.[c20000].End(xlUp)(2).Resize(Vung.Rows.Count).Value = [c1]
        wNKPS.[d20000].End(xlUp)(2).Resize(Vung.Rows.Count, 9).Value = Vung.Offset(, 2).Resize(Vung.Rows.Count, 9).Value
            Set iHang = wHome.Range(wHome.[a7], wHome.[a100].End(xlUp))
            ReDim Mg(1 To iHang.Rows.Count, 1 To 6)
            Mg = wHome.Range(wHome.[a7], wHome.[a100].End(xlUp)).Resize(, 6).Value
            kK = 1
                For I = 1 To iHang.Rows.Count
                    If Not dHome.exists(iHang(I).Value) Then
                        dHome.Add iHang(I).Value, kK
                    End If
                        kK = kK + 1
                Next I
                    For I = 1 To Vung.Rows.Count
                        mM = dHome.Item(Vung(I).Offset(, 2).Value)
                            If [c1] = "Nhap" And Vung(I).Offset(, 7) = "Tot" Then
                                Mg(mM, 5) = Mg(mM, 5) + Vung(I).Offset(, 6).Value
                            ElseIf [c1] = "Nhap" And Vung(I).Offset(, 7) = "Hong" Then
                                Mg(mM, 4) = Mg(mM, 4) + Vung(I).Offset(, 6)
                            ElseIf [c1] = "Xuat" And Vung(I).Offset(, 7) = "Tot" Then
                                Mg(mM, 5) = Mg(mM, 5) - Vung(I).Offset(, 6)
                            Else
                                Mg(mM, 4) = Mg(mM, 4) - Vung(I).Offset(, 6)
                            End If
                    Next I
                            wHome.[a7].Resize(iHang.Rows.Count, 6) = Mg
    Union(Vung.Resize(, 3), Vung.Offset(, 4).Resize(, 2), Vung.Offset(, 8).Resize(, 3)).ClearContents
End Sub

"Bi" giờ khi xuất:
- Nếu xuất trúng Mã mà hết sạch thì nó báo nhưng không thoát, nó tiếp tục đi kiếm những "em" khác
- Nếu có đủ thì nó ..."thịt" đủ
- Nếu lẫn lộn vừa có vừa không thì cứ "thằng" nào không có thì nó báo, còn có là nó ..."thịt"
Nhưng như thế thì nó đem cả những thằng không có qua sheet NKPS luôn, híc
Thôi cái này chờ ý kiến bạn vậy
Theo mình khi xuất thì phải kiểm tra trước, nếu có một hay nhiều đoạn không có thì ta thoát ngay, phải sửa những dữ liệu đó

 

[othanhquango]

Mình có một số nhận xét như sau:

Nhập:
- Chỉ cần gán giá trị của số đầu, số cuối thôi. Không cần gán chiều dài. Vì bên sheet chi tiết đã có công thức tính chiều dài.
Xuất:
- Không có đoạn đó nên dừng luôn lệnh gán qua NKPS. Tốt nhất là gán theo từng mã hàng trên từng dòng, thỏa => gán, rồi clear nó. Không thỏa không làm gì hết. Cứ như vậy cho đến hết từ trên xuống dưới. Số đoạn còn lại là số không có bên sheet chi tiết.
- Cả nhập và xuất đều tác động đến sheet Home => làm mất hết công thức và hiện số liệu sai. Bạn có thể không cần tác động gì đến sheet này cũng được, vì sheet này sau này có thể dùng công thức để tính.

Mình có một phương án giải quyết vấn đề XUẤT như thế này, nhưng tiếc là mình không rành VBA cho lắm nên không biết code thế nào:

IF là Nhập then
     Code (cái này anh em làm như mong muốn của mình rồi)
  Trường hợp Xuất
  -          Duyệt từng mã hàng từ trên xuống dưới
              Nếu tại vị trí mã hàng. Offset(0,6) =”Hong”
                    Làm việc trên sheet ChiTietHong (ngược lại làm việc trên sheet ChiTietTot, dựa vào mã hàng để xác định 2 cột số đầu, số cuối bên sheet chi tiết.
                         Từ vị trí mã hàng. Offset (0,2) => lấy số đầu tìm trong cả 2 cột số đầu ,số cuối bên chi tiết:
                                Nếu không có => chuyển đến mã hàng tiếp theo.
                                Nếu có => lưu lại số thứ tự của hàng tìm được đó.
                         Từ vị trí mã hàng. Offset (0,3) => lấy số cuối tìm trong cả 2 cột số đầu, số cuối bên chi tiết:
                                Nếu không có => chuyển đến mã hàng tiếp theo.
                                Nếu có => lưu lại số thứ tự của hàng tìm được đó.
  Sau đó lấy 02 cái lưu lại đó so sánh với nhau, nếu cùng hàng => cùng 1 đoạn
                               Thực hiện tiếp 3 lệnh:
  -                                                                                       Xóa trên sheet chi tiết vị trí đó.
  -                                                                                       Xóa trên sheet đang nhập dòng tương ứng. ( không làm lệnh này cuối cùng, mục đích để sau khi gán nhìn vô còn cái nào chưa xóa => biết nó không có)
  -                                                                                       Gán qua sheet NKNX.
  Chuyển sang mã hàng tiếp theo ở dòng tiếp theo
  Kết thúc.

Mấu chốt của thuật toán này là so sánh số thứ tự hàng của 2 số tìm được bên sheets chi tiết: số đầu, số cuối tìm được. Như vậy dù đảo số đầu số cuối thì excel vẫn hiểu.

 

[othanhquango]

Hic, nhờ anh em diễn đàn GPE giúp mình.

 

[huuthang_bd]

Làm đại biết đâu lại trúng

Sub Main()
Application.ScreenUpdating = False
Dim EndR As Long, i As Long, Sh As Worksheet, CodeCol As Long, FindRng As Range, MyAdd As String, CodeRng As Range
EndR = PS.[C65536].End(xlUp).Row
If EndR = 4 Then
    MsgBox "Khong co du lieu"
    Exit Sub
End If
For i = 5 To EndR
    If PS.Cells(i, "C").Value = "" Then GoTo DongKeTiep
    Set Sh = IIf(PS.Cells(i, "H").Value = "Tot", Tot, Hg)
    CodeCol = Application.WorksheetFunction.Match(PS.Cells(i, "C").Value, Sh.[1:1], 0)
    If PS.[C1].Value = "Xuat" Then
        Set CodeRng = Sh.Range(Sh.Cells(2, CodeCol), Sh.Cells(65536, CodeCol + 1).End(xlUp))
        Set FindRng = CodeRng.Find(What:=PS.Cells(i, "E").Value, After:=Sh.Cells(2, CodeCol), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        If FindRng Is Nothing Then GoTo DongKeTiep
        MyAdd = FindRng.Address
        Do
            If PS.Cells(i, "F").Value = FindRng.Offset(, IIf(Sh.Cells(2, FindRng.Column).Value = "S" & ChrW(7889) & " " & ChrW(273) & ChrW(7847) & "u", 1, -1)).Value Then
                With Sh.Cells(65536, CodeCol).End(xlUp).Resize(, 2)
                    FindRng.Offset(, IIf(Sh.Cells(2, FindRng.Column).Value = "S" & ChrW(7889) & " " & ChrW(273) & ChrW(7847) & "u", 0, -1)).Resize(, 2).Value = .Value
                    .ClearContents
                End With
                CopyToNK i
                GoTo DongKeTiep
            End If
            Set FindRng = CodeRng.FindNext(FindRng)
        Loop While FindRng.Address <> MyAdd
    Else
        Sh.Cells(65536, CodeCol).End(xlUp).Offset(1).Resize(, 2).Value = PS.Cells(i, "E").Resize(, 2).Value
        CopyToNK i
    End If
DongKeTiep:
Next
Application.ScreenUpdating = False
End Sub

Sub CopyToNK(MyRow As Long)
    With NK.[D65536].End(xlUp).Offset(1, -3)
        .Resize(, 2).Value = PS.Cells(MyRow, "A").Resize(, 2).Value
        .Offset(, 2).Value = PS.[C1].Value
        .Offset(, 3).Resize(, 9).Value = PS.Cells(MyRow, "C").Resize(, 9).Value
    End With
    Union(PS.Cells(MyRow, "A").Resize(, 3), PS.Cells(MyRow, "E").Resize(, 2), PS.Cells(MyRow, "I").Resize(, 3)).ClearContents
End Sub

Download file về test thử nha.

 

[othanhquango]

Cao thủ, vừa test sơ bộ thì thấy rất hài lòng. Triển khai rất đúng ý mình, rất chân thành cảm ơn bạn.
Để mình test thêm một thời gian nữa xem thế nào. Vì cái này cần phải có sự chính xác tuyệt đối.