Nhờ giúp đỡ hoàn thiện code file Quản lý thư viện của anh Yeudoi?

[thanhphuongvip]

Xin chào mọi người, mình có tải file quản lý thư viện của anh yêu đời để áp dụng, tuy nhiên file cần nhiều bất cập khi áp dụng vào thực tế.
Mình xin phép nêu từng vấn đề một vào topic này, mong anh em nào đi qua giúp đỡ mình hoàn thiện nhé!
[Mỗi bài đều có file đính kèm]

1. Vấn đề 1:

Vào mục Nhập liệu sách.


Với trường hợp Nhập sách từ việc mua thêm, Mình muốn khi nhập Mã sách, nếu mã sách đã có tồn tại trong sheet("Sach") thì nó sẽ show các thông tin liên quan của Mã sách đó vào các mục còn lại như Tên sách, Tên tác giả, số trang, ..... Mục đích là để thông tin đc trùng khớp mã đã tồn tại. Còn đối với mã nào gõ vào mà chưa tồn tại thì xem như nhập mới.




Và khi chúng ta vào Mục Bảng kê sách, những sách trùng ở bảng nhập thì sẽ gộp và sumif lại.





Cảm ơn anh em đã trợ giúp!

 

[thanhphuongvip]

Anh em ơi, rảnh giúp với nhé!

 

[snow25]

Xin chào mọi người, mình có tải file quản lý thư viện của anh yêu đời để áp dụng, tuy nhiên file cần nhiều bất cập khi áp dụng vào thực tế.
Mình xin phép nêu từng vấn đề một vào topic này, mong anh em nào đi qua giúp đỡ mình hoàn thiện nhé!
[Mỗi bài đều có file đính kèm]

1. Vấn đề 1:

Vào mục Nhập liệu sách.
View attachment 215874

Với trường hợp Nhập sách từ việc mua thêm, Mình muốn khi nhập Mã sách, nếu mã sách đã có tồn tại trong sheet("Sach") thì nó sẽ show các thông tin liên quan của Mã sách đó vào các mục còn lại như Tên sách, Tên tác giả, số trang, ..... Mục đích là để thông tin đc trùng khớp mã đã tồn tại. Còn đối với mã nào gõ vào mà chưa tồn tại thì xem như nhập mới.

View attachment 215876


Và khi chúng ta vào Mục Bảng kê sách, những sách trùng ở bảng nhập thì sẽ gộp và sumif lại.

View attachment 215878

View attachment 215879

Cảm ơn anh em đã trợ giúp!

Làm cho bạn ý thứ nhất.Ý thứ 2.2 cái đơn giá khác nhau gộp kiểu gì ta.

 

[thanhphuongvip]

Làm cho bạn ý thứ nhất.Ý thứ 2.2 cái đơn giá khác nhau gộp kiểu gì ta.

Cảm ơn snow25!
ah , trên hình demo là mình nhập đại nên 2 đơn giá khác nhau, nhưng thực tế nếu mã giống nhau thì đơn giá bìa hoàn toàn giống nhau (Vì đã khắc phục ở bước 1), vì thế nên gộp được.
Bạn xem giúp mình được không?

Cảm ơn bạn!

(Mình gửi lại file đã chỉnh cho nó giống nhau rồi)

 

[snow25]

Cảm ơn snow25!
ah , trên hình demo là mình nhập đại nên 2 đơn giá khác nhau, nhưng thực tế nếu mã giống nhau thì đơn giá bìa hoàn toàn giống nhau (Vì đã khắc phục ở bước 1), vì thế nên gộp được.
Bạn xem giúp mình được không?

Cảm ơn bạn!

(Mình gửi lại file đã chỉnh cho nó giống nhau rồi)

Bạn chạy cái code này nhé.Lưu ý là khi dữ liệu vượt quá giới hạn dòng của bạn có sẵn nó sẽ chèn vào dòng tổng của bạn.

Sub Bangkesach()
    Application.ScreenUpdating = False
            Dim arr, arr1, dic As Object, i As Long, j As Long, lr As Long, b As Long
            Set dic = CreateObject("scripting.dictionary")
        With Sheets("Sach")
             lr = .Range("C" & Rows.Count).End(xlUp).Row
             If lr < 6 Then Exit Sub
             arr = .Range("C6:P" & lr).Value
             ReDim arr1(1 To UBound(arr, 1), 1 To 8)
             For i = 1 To UBound(arr, 1)
                 If Not dic.exists(arr(i, 1)) Then
                    a = a + 1
                    dic.Add arr(i, 1), a
                    arr1(a, 1) = arr(i, 1)
                    arr1(a, 2) = arr(i, 2)
                    arr1(a, 3) = arr(i, 3)
                    arr1(a, 4) = arr(i, 13)
                    arr1(a, 5) = arr(i, 9)
                    arr1(a, 6) = arr(i, 10)
                    arr1(a, 7) = arr(i, 11)
                    arr1(a, 8) = arr(i, 12)
                 Else
                    b = dic.Item(arr(i, 1))
                    arr1(b, 6) = arr1(b, 6) + arr(i, 10)
                    arr1(b, 8) = arr1(b, 8) + arr(i, 12)
                 End If
            Next i
       End With
       With Sheets("Bangkesach")
            .Range("C8:J16").ClearContents
            If a Then .Range("C8:J8").Resize(a).Value = arr1
       End With
    Application.DisplayAlerts = False
    Sheets("Bangkesach").Select
    Range("C7").Select
End Sub

 

[thanhphuongvip]

Bạn chạy cái code này nhé.Lưu ý là khi dữ liệu vượt quá giới hạn dòng của bạn có sẵn nó sẽ chèn vào dòng tổng của bạn.

Sub Bangkesach()
    Application.ScreenUpdating = False
            Dim arr, arr1, dic As Object, i As Long, j As Long, lr As Long, b As Long
            Set dic = CreateObject("scripting.dictionary")
        With Sheets("Sach")
             lr = .Range("C" & Rows.Count).End(xlUp).Row
             If lr < 6 Then Exit Sub
             arr = .Range("C6:P" & lr).Value
             ReDim arr1(1 To UBound(arr, 1), 1 To 8)
             For i = 1 To UBound(arr, 1)
                 If Not dic.exists(arr(i, 1)) Then
                    a = a + 1
                    dic.Add arr(i, 1), a
                    arr1(a, 1) = arr(i, 1)
                    arr1(a, 2) = arr(i, 2)
                    arr1(a, 3) = arr(i, 3)
                    arr1(a, 4) = arr(i, 13)
                    arr1(a, 5) = arr(i, 9)
                    arr1(a, 6) = arr(i, 10)
                    arr1(a, 7) = arr(i, 11)
                    arr1(a, 8) = arr(i, 12)
                 Else
                    b = dic.Item(arr(i, 1))
                    arr1(b, 6) = arr1(b, 6) + arr(i, 10)
                    arr1(b, 8) = arr1(b, 8) + arr(i, 12)
                 End If
            Next i
       End With
       With Sheets("Bangkesach")
            .Range("C8:J16").ClearContents
            If a Then .Range("C8:J8").Resize(a).Value = arr1
       End With
    Application.DisplayAlerts = False
    Sheets("Bangkesach").Select
    Range("C7").Select
End Sub

Đúng rồi, mình sẽ viết thêm một code để tự động đưa dòng tổng cộng xuống bên dưới cùng, rồi up lên bạn xem thử nhé!