Xin hỏi cách tạo form nhập liệu tự động về các sheet có sẵn (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

dodinhkhai

Thành viên mới
Tham gia
3/10/13
Bài viết
23
Được thích
0
Em chào các anh.
Em đang có nhu cầu thế này: Có danh sách học sinh các lớp với đầy đủ các thông tin cá nhân rồi. Trong quá trình học có thể thông tin đó được bổ sung. Có nhiều người cùng phải bổ sung thêm thông tin. Nếu 1 vài người thì mình có thể tìm tới mục của họ để điền thêm nhưng nếu mỗi lần thay đổi có khoảng 50 người thì tìm từng người một để thêm thông tin thì thật là vất vả.
Vậy nên e muốn hỏi các anh cách tạo 1 form nhập liệu như vậy.
Em đã tạo 1 file excel và trình bày rõ mục đích yêu cầu trong đó, mong các anh giúp đỡ!
 

File đính kèm

Em chào các anh.
Em đang có nhu cầu thế này: Có danh sách học sinh các lớp với đầy đủ các thông tin cá nhân rồi. Trong quá trình học có thể thông tin đó được bổ sung. Có nhiều người cùng phải bổ sung thêm thông tin. Nếu 1 vài người thì mình có thể tìm tới mục của họ để điền thêm nhưng nếu mỗi lần thay đổi có khoảng 50 người thì tìm từng người một để thêm thông tin thì thật là vất vả.
Vậy nên e muốn hỏi các anh cách tạo 1 form nhập liệu như vậy.
Em đã tạo 1 file excel và trình bày rõ mục đích yêu cầu trong đó, mong các anh giúp đỡ!

Một cách đơn giản nhất là tất cả các lớp nhập chung vào 1 sheet, muốn tìm em nào thì chọn cột đó và dùng chức năng Find, sau đó chọn em cần tìm rồi nhấn nút sang phải đến cột cần ghi thì gõ nhập vào.

Muốn tách lớp nào thì dùng AdvanFilter là xong, bạn sử dụng nhiều sheet chi cho phức tạp ra.
 
Upvote 0
Em chào các anh.
Em đang có nhu cầu thế này: Có danh sách học sinh các lớp với đầy đủ các thông tin cá nhân rồi. Trong quá trình học có thể thông tin đó được bổ sung. Có nhiều người cùng phải bổ sung thêm thông tin. Nếu 1 vài người thì mình có thể tìm tới mục của họ để điền thêm nhưng nếu mỗi lần thay đổi có khoảng 50 người thì tìm từng người một để thêm thông tin thì thật là vất vả.
Vậy nên e muốn hỏi các anh cách tạo 1 form nhập liệu như vậy.
Em đã tạo 1 file excel và trình bày rõ mục đích yêu cầu trong đó, mong các anh giúp đỡ!

1. Nhìn MHS thì thấy có vẻ là duy nhất trong toàn trường chứ không chỉ trong toàn lớp. Đúng thế?
2. "Khi bấm nút Nhập dữ liệu thì tự động tìm trong danh sách (nền vàng) xem học sinh đó là ai, lớp nào,…"
Nếu thế thì Form với danh sách (ListBox?) để làm gì? Đằng nào thì cũng nhập tất tần tật từ danh sách xuống các sheet Lớp. Vậy thì nhập luôn từ Sheet InputForm chứ tạo Form làm gì?
3. Tôi đề nghị thay vì "Lớp A" thì chỉ là A thôi. Lý do: "Lớp" là unicode. Lúc này gõ unicode dựng sẵn lúc khác gõ unicode tổ hợp thì code tèo. Mà có khi do sơ ý lại là "Lớp<2 dấu cách>C" thì code cũng tèo. Nói chung là nên hạn chế cơ hội rủi ro tới mức tối thiểu.
4. Bạn không nhất quán. A!G2, A!G3 và B!G2 có dấu phẩy ở cuối trong khi B!G5 không có. Tôi đề nghị xóa dấu phẩy ở cuối.
 
Upvote 0
Một cách đơn giản nhất là tất cả các lớp nhập chung vào 1 sheet, muốn tìm em nào thì chọn cột đó và dùng chức năng Find, sau đó chọn em cần tìm rồi nhấn nút sang phải đến cột cần ghi thì gõ nhập vào.

Muốn tách lớp nào thì dùng AdvanFilter là xong, bạn sử dụng nhiều sheet chi cho phức tạp ra.
Nếu gộp thành 1 sheet thì câu chuyện trở thành dễ dàng hơn nhiều rồi nhưng e lại phải làm việc với nhiều sheet như vậy cơ :(
 
Upvote 0
1. Nhìn MHS thì thấy có vẻ là duy nhất trong toàn trường chứ không chỉ trong toàn lớp. Đúng thế?
2. "Khi bấm nút Nhập dữ liệu thì tự động tìm trong danh sách (nền vàng) xem học sinh đó là ai, lớp nào,…"
Nếu thế thì Form với danh sách (ListBox?) để làm gì? Đằng nào thì cũng nhập tất tần tật từ danh sách xuống các sheet Lớp. Vậy thì nhập luôn từ Sheet InputForm chứ tạo Form làm gì?
3. Tôi đề nghị thay vì "Lớp A" thì chỉ là A thôi. Lý do: "Lớp" là unicode. Lúc này gõ unicode dựng sẵn lúc khác gõ unicode tổ hợp thì code tèo. Mà có khi do sơ ý lại là "Lớp<2 dấu cách>C" thì code cũng tèo. Nói chung là nên hạn chế cơ hội rủi ro tới mức tối thiểu.
4. Bạn không nhất quán. A!G2, A!G3 và B!G2 có dấu phẩy ở cuối trong khi B!G5 không có. Tôi đề nghị xóa dấu phẩy ở cuối.
1. Đúng là mỗi học sinh có 1 mã học sinh riêng, ko thể trùng nhau.
2. E hình dung trong đầu là mọi thứ sẽ như thế và cần phải tạo 1 nút bấm là "Nhập" để khi ấn vào đó excel sẽ tự biết tìm tới em học sinh đó để điền tên hoạt động vào tiếp phần Hoạt động đang có sẵn.
3. Việc góp ý đặt tên thế là đúng ạ, em quên mất vụ dấu unicode, em sẽ sửa.
4. Dấu phẩy đó mục đích là để phân biệt các hoạt động, có thể bỏ cũng được ạ nhưng miễn sao khi nhập vào thì có dấu phẩy phân cách các hoạt động ra. Ví dụ ban đầu cell A!G2 đang là "Hoạt động A, hoạt động B" thì sau khi ấn nút NHập sẽ thành "Hoạt động A, hoạt động B, hoạt động C".
Em không biết cách làm sao để tạo chức năng tự động như vậy nên mong được hướng dẫn ạ! Em cảm ơn.
 
Upvote 0
1. Đúng là mỗi học sinh có 1 mã học sinh riêng, ko thể trùng nhau.
2. E hình dung trong đầu là mọi thứ sẽ như thế và cần phải tạo 1 nút bấm là "Nhập" để khi ấn vào đó excel sẽ tự biết tìm tới em học sinh đó để điền tên hoạt động vào tiếp phần Hoạt động đang có sẵn.
3. Việc góp ý đặt tên thế là đúng ạ, em quên mất vụ dấu unicode, em sẽ sửa.
4. Dấu phẩy đó mục đích là để phân biệt các hoạt động, có thể bỏ cũng được ạ nhưng miễn sao khi nhập vào thì có dấu phẩy phân cách các hoạt động ra. Ví dụ ban đầu cell A!G2 đang là "Hoạt động A, hoạt động B" thì sau khi ấn nút NHập sẽ thành "Hoạt động A, hoạt động B, hoạt động C".
Em không biết cách làm sao để tạo chức năng tự động như vậy nên mong được hướng dẫn ạ! Em cảm ơn.

Bạn thử test tập tin đính kèm bên dưới.
Tôi hướng dẫn để bạn biết phải làm thế nào trong tương lai
1. Mở tập tin dưới
2. Alt + F11 --> phải chuột trên Module1 --> Export File --> chọn nơi ghi Module1
3. Trong tương lai bạn có tập tin dữ liệu thực thì: mở tập tin thực --> Alt + F11 --> File --> Inport --> duyệt tới Module1 để thêm --> đặt Button trên sheet InputForm và gán cho nó Macro WriteData

Tên Module1 nên đổi cho sát với nội dung của nó.
Cấu trúc dữ liệu phải giữ nguyên: dữ liệu bặt đầu từ dòng nào, cột nào, số và thứ tực các cột v...v
 

File đính kèm

Upvote 0
Bạn thử test tập tin đính kèm bên dưới.
Tôi hướng dẫn để bạn biết phải làm thế nào trong tương lai
1. Mở tập tin dưới
2. Alt + F11 --> phải chuột trên Module1 --> Export File --> chọn nơi ghi Module1
3. Trong tương lai bạn có tập tin dữ liệu thực thì: mở tập tin thực --> Alt + F11 --> File --> Inport --> duyệt tới Module1 để thêm --> đặt Button trên sheet InputForm và gán cho nó Macro WriteData

Tên Module1 nên đổi cho sát với nội dung của nó.
Cấu trúc dữ liệu phải giữ nguyên: dữ liệu bặt đầu từ dòng nào, cột nào, số và thứ tực các cột v...v
Em cảm ơn anh nhiều! Đúng ý em luôn.
Em sẽ tìm hiểu đoạn code này để áp dụng cho vấn đề của mình. Trong quá trình làm nếu có vấn đề gì chưa rõ mong a sẽ tiếp tục chỉ bảo.
 
Upvote 0
Anh siwtom ơi cho em hỏi.
Trong 1 cell nếu muốn xuống dòng thì thường là nhấn Alt + Enter.
Vậy trong code VB này thì làm sao để mỗi lần mình ấn Nhập nó sẽ tự động xuống dòng.
Ví dụ:
"Hoạt động A, Hoạt động B" thì sẽ là:
"Hoạt động A,
Hoạt động B"
Em cảm ơn.
 
Upvote 0
Anh siwtom ơi cho em hỏi.
Trong 1 cell nếu muốn xuống dòng thì thường là nhấn Alt + Enter.
Vậy trong code VB này thì làm sao để mỗi lần mình ấn Nhập nó sẽ tự động xuống dòng.
Ví dụ:
"Hoạt động A, Hoạt động B" thì sẽ là:
"Hoạt động A,
Hoạt động B"
Em cảm ơn.

Trong Sub WriteData bạn tìm dòng
Mã:
rng.Offset(, 6).Value = rng.Offset(, 6) & ", " & chuongtrinh

và thay bằng (giống như trên sheet Alt + Enter)
Mã:
rng.Offset(, 6).Value = rng.Offset(, 6) & "," & vbLf & chuongtrinh

hoặc bằng ... cũng được

Mã:
rng.Offset(, 6).Value = rng.Offset(, 6) & "," & vbCrLf & chuongtrinh
 
Upvote 0
Trong Sub WriteData bạn tìm dòng
Mã:
rng.Offset(, 6).Value = rng.Offset(, 6) & ", " & chuongtrinh

và thay bằng (giống như trên sheet Alt + Enter)
Mã:
rng.Offset(, 6).Value = rng.Offset(, 6) & "," & vbLf & chuongtrinh

hoặc bằng ... cũng được

Mã:
rng.Offset(, 6).Value = rng.Offset(, 6) & "," & vbCrLf & chuongtrinh
Em cảm ơn anh nhiều!
 
Upvote 0
Em đã làm lại từ file trắng và đã ra rồi!
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
em mới làm nhờ các anh chị trong diễn đàn giúp em với ạ, em có 1 file về nhập hàng LTTP theo thứ tự từ ngày 1 đến 31 hàng tháng, trong đó cứ 5 ngày tổng hợp 1 lần, và 1 mặt hàng lại tương ứng 1 sheet, em muốn nhờ anh chị giúp em tạo form nhập liệu cho nhanh với ạ, em cám ơn ạ
 

File đính kèm

Upvote 0
Em mới làm nhờ các anh chị trong diễn đàn giúp em với ạ, em có 1 file về nhập hàng LTTP theo thứ tự từ ngày 1 đến 31 hàng tháng, trong đó cứ 5 ngày tổng hợp 1 lần, và 1 mặt hàng lại tương ứng 1 sheet, em muốn nhờ anh chị giúp em tạo form nhập liệu cho nhanh với ạ, em cám ơn ạ
Nếu là mình thì mình sẽ xây dững 1 CSDL theo các trang như sau:
1. Trang 'DMuc' gồm các bảng (Table)
1.a Bảng danh mục đơn vị, gồm các trường [Mã DV], [Tên ĐV], . . . ([Ghi chú]}
1b Danh mục các mặt hàng
PHP:
Mã HH    Tên hàng   ĐVT    (Tồn ĐN)
LTG01   Giạo tẻ      Kg     4.202
GVM00   Muối         Kg     13.5
TFTB0   Thịt bò      Kg      0.85
TFTL9   Thịt mỡ (heo)Lít    123
TFTHA   Thị mông     Kg     0.5
. . . .      . . . ..   . .  . . .
1c (Nếu cần) Danh mục các nhà cung cấp

2A Trang quan trọng ghi dữ liệu nhập, gồm
[Ngày], [Nhà CC], [Mã HH], [Số lượng],. . . . [Ghi chú]
2B Trang quan trọng nữa là trang 'Xuat'
[Ngày], [Số Phiếu], . . . . .

Một khi có 1 thiết kế CSDL như thế thì xử lý số liệu trong tháng hay trong năm đều được

Rất vui nếu được tiếp tục trao đổi cùng bạn theo hướng này
 
Upvote 0
Nếu là mình thì mình sẽ xây dững 1 CSDL theo các trang như sau:
1. Trang 'DMuc' gồm các bảng (Table)
1.a Bảng danh mục đơn vị, gồm các trường [Mã DV], [Tên ĐV], . . . ([Ghi chú]}
1b Danh mục các mặt hàng
PHP:
Mã HH    Tên hàng   ĐVT    (Tồn ĐN)
LTG01   Giạo tẻ      Kg     4.202
GVM00   Muối         Kg     13.5
TFTB0   Thịt bò      Kg      0.85
TFTL9   Thịt mỡ (heo)Lít    123
TFTHA   Thị mông     Kg     0.5
. . . .      . . . ..   . .  . . .
1c (Nếu cần) Danh mục các nhà cung cấp

2A Trang quan trọng ghi dữ liệu nhập, gồm
[Ngày], [Nhà CC], [Mã HH], [Số lượng],. . . . [Ghi chú]
2B Trang quan trọng nữa là trang 'Xuat'
[Ngày], [Số Phiếu], . . . . .

Một khi có 1 thiết kế CSDL như thế thì xử lý số liệu trong tháng hay trong năm đều được

Rất vui nếu được tiếp tục trao đổi cùng bạn theo hướng này
em cám ơn ạ, anh có thể tạo giúp e mẫu như thế ko ạ?em còn hạn chế về VBA lắm ạ, anh giúp em với
 
Upvote 0
em cám ơn ạ, anh có thể tạo giúp e mẫu như thế ko ạ?em còn hạn chế về VBA lắm ạ, anh giúp em với
Bạn xem file & bổ sung vài mặt hàng thực tế ở đơn vị bạn;
Sau đó ta tiến hành sang bước nhập hàng:
Bạn mô tả quá trình nhập dữ liệu, chúng ta sẽ thiết kế tới trang 'Nhap'

(Đã tháo file đính kèm; Xin mời các bạn xem file bài dưới tiếp theo)
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn xem file & bổ sung vài mặt hàng thực tế ở đơn vị bạn;
Sau đó ta tiến hành sang bước nhập hàng:
Bạn mô tả quá trình nhập dữ liệu, chúng ta sẽ thiết kế tới trang 'Nhap'
thầy ơi trên file cũa LTTP e gửi thầy là có thứ tự từng mặt hàng xuất cho đơn vị, e muốn tạo 1 form để nhập đc cho tất cả các sheet có nội dung bên trong tương tự nhau: ví dụ như P.thịt, P. giá đỗ, P.trứng......
 
Upvote 0
Vậy ở đơn vị bạn là nhập hàng về thì xuất thẳng cho các đơn vị luôn hay sao?
Thường thì nhập hàng vô kho rồi xuất cho các đơn vị chứ nhỉ?
Mình hỏi vậy vì 2 hướng này có cách giảu quyết khác nhau à nha.
 
Upvote 0
Vậy ở đơn vị bạn là nhập hàng về thì xuất thẳng cho các đơn vị luôn hay sao?
Thường thì nhập hàng vô kho rồi xuất cho các đơn vị chứ nhỉ?
Mình hỏi vậy vì 2 hướng này có cách giảu quyết khác nhau à nha.
Dạ bên e là nhập hàng về xong cấp trực tiếp luôn cho đơn vị hết ạ
Bên e không để lại tồn kho mà đảm bảo thực phẩm tươi sống luôn ạ
 
Upvote 0
Bạn thử thao tác với form nhập/xuất này & đối chiếu với cách làm lâu nay của ĐV bạn có gì cần điều chỉnh

(Thay file mói lúc 08:09 & xin mời xem file ở những bài tiếp sau)
 
Lần chỉnh sửa cuối:
Upvote 0
Còn đây là file chứa Form nhập theo từng phiếu cho từng đơn vị
Bạn theo tác thử & cho ý kiến để còn cải tiến có thể

File đã thu hồi; Xin các bạn xem file ở các bài tiếp theo
 
Lần chỉnh sửa cuối:
Upvote 0
Còn đây là file chứa Form nhập theo từng phiếu cho từng đơn vị
Bạn theo tác thử & cho ý kiến để còn cải tiến có thể

(Chiều muộn mình sẽ thu hội file bài trước)
Bài đã được tự động gộp:

Bài đã được tự động gộp:

Bài đã được tự động gộp:
Dạ thầy xem giúp e ạ
Bài đã được tự động gộp:

Còn đây là file chứa Form nhập theo từng phiếu cho từng đơn vị
Bạn theo tác thử & cho ý kiến để còn cải tiến có thể

(Chiều muộn mình sẽ thu hội file bài trước)
 

File đính kèm

  • 4AC8F3C1-6541-46E1-986C-8CCC781C2F5D.jpeg
    4AC8F3C1-6541-46E1-986C-8CCC781C2F5D.jpeg
    355.9 KB · Đọc: 19
  • 692FD6BB-9CC9-46E3-8A7B-1848919A32BC.jpeg
    692FD6BB-9CC9-46E3-8A7B-1848919A32BC.jpeg
    159.5 KB · Đọc: 18
  • tỏng hợp 5 ngày.xlsx
    tỏng hợp 5 ngày.xlsx
    84.7 KB · Đọc: 18
Lần chỉnh sửa cuối:
Upvote 0
Còn đây là file chứa Form nhập theo từng phiếu cho từng đơn vị
Bạn theo tác thử & cho ý kiến để còn cải tiến có thể

(Chiều muộn mình sẽ thu hội file bài trước)
Bài đã được tự động gộp:

dạ em điều chỉnh rồi ạ
 

File đính kèm

Upvote 0
Bạn kiểm số liệu theo trang 'THop'
Sau đó thử nhập thêm số liệu & kiểm tra tiếp
Chúc vui!

CN 6h15: Đã thay file mới với Font chữ trong Form rõ & đậm hơn
Còn chuyện sửa dòng dữ liệu chưa làm ra kết quả; Hãy đợi thêm thời gian
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Xem thề dễ ợt, file file lên rồi ngắm 1 lúc là xong
Còn chuyện giúp thì chưa thể vì có dữ liệu đâu mà tổng hợp?
Muốn được giúp phần tổng hợp này thì lấy file bài trên của mình; nhập số liệu 1 tháng nào đó mới có cơ sở để mà tổng hợp
 
Upvote 0
Xem thề dễ ợt, file file lên rồi ngắm 1 lúc là xong
Còn chuyện giúp thì chưa thể vì có dữ liệu đâu mà tổng hợp?
Muốn được giúp phần tổng hợp này thì lấy file bài trên của mình; nhập số liệu 1 tháng nào đó mới có cơ sở để mà tổng hợp
Dạ vâng ạ
 
Upvote 0
Mình viết thử tồng hợp 2 mặt hàng đâu hủ & giá đỗ ở [A13]
Bạn kiểm tra & nhập thêm số liệu kiểm lại thử

Chúc ngày đầu tuần thành công!

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [A13]) Is Nothing Then
    Dim Arr()
    Dim Rws As Long, Dg As Integer, J As Long, Cot As Integer
    Dim MaHg As String
    
    ReDim dArr(1 To 6, 1 To 27)                 '6 Dòng & 27 DVi            '
1 'Tìm Mã Theo Ngành Hàng Cân Báo Cáo:   '
    For J = 2 To 35
        With Sheets("DMuc")
            If .Cells(J, "X").Value = Target.Value Then
                MaHg = Left(.Cells(J, "Y").Value, 3):       Exit For
            End If
         End With
    Next J
2 'Tìm Hàng Hóa Cân Cho BC   '
    With Sheets("CSDL")
        Arr() = .[A1].CurrentRegion.Offset(1).Value
        For J = 1 To UBound(Arr())
            If Left(Arr(J, 5), 3) = MaHg Then
21 '  Tìm Dòng Theo Ngày Xuât Hàng & Côt Theo Don Vi Nhân Hàng:          '
                Dg = XDDg(Arr(J, 1)):                           Cot = XDCt(Arr(J, 4))
                dArr(Dg, Cot) = dArr(Dg, Cot) + Arr(J, 8)
            End If
        Next J
    End With
3 ' Hiên Kêt Qua Thu Duoc:         '
    [B13].Resize(6, 27).Value = dArr()
 End If
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Mình viết thử tồng hợp 2 mặt hàng đâu hủ & giá đỗ ở [A13]
Bạn kiểm tra & nhập thêm số liệu kiểm lại thử

Chúc ngày đầu tuần thành công!

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [A13]) Is Nothing Then
    Dim Arr()
    Dim Rws As Long, Dg As Integer, J As Long, Cot As Integer
    Dim MaHg As String

    ReDim dArr(1 To 6, 1 To 27)                 '6 Dòng & 27 DVi            '
1 'Tìm Mã Theo Ngành Hàng Cân Báo Cáo:   '
    For J = 2 To 35
        With Sheets("DMuc")
            If .Cells(J, "X").Value = Target.Value Then
                MaHg = Left(.Cells(J, "Y").Value, 3):       Exit For
            End If
         End With
    Next J
2 'Tìm Hàng Hóa Cân Cho BC   '
    With Sheets("CSDL")
        Arr() = .[A1].CurrentRegion.Offset(1).Value
        For J = 1 To UBound(Arr())
            If Left(Arr(J, 5), 3) = MaHg Then
21 '  Tìm Dòng Theo Ngày Xuât Hàng & Côt Theo Don Vi Nhân Hàng:          '
                Dg = XDDg(Arr(J, 1)):                           Cot = XDCt(Arr(J, 4))
                dArr(Dg, Cot) = dArr(Dg, Cot) + Arr(J, 8)
            End If
        Next J
    End With
3 ' Hiên Kêt Qua Thu Duoc:         '
    [B13].Resize(6, 27).Value = dArr()
End If
End Sub
Thầy xem hộ em xem nên tạo form sao cho phù hợp ạ
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Thử nhập liệu vô 7 đơn vị này xem sao?!?
Chủ yếu là dòng cần nhập trúng khớp
 
Upvote 0
Nhập liệu cho toàn bộ các đơn vị
Có thêm ngành hàng 'Mua lẽ'
Có nút lệnh để xóa toàn bộ dữ liệu của tháng đã nhập trước đó

(Chiều nay mình sẽ thu hồi file bài trên liền kề)
 
Upvote 0
Nhập liệu cho toàn bộ các đơn vị
Có thêm ngành hàng 'Mua lẽ'
Có nút lệnh để xóa toàn bộ dữ liệu của tháng đã nhập trước đó

(Chiều nay mình sẽ thu hồi file bài trên liền kề)
thầy xem giúp em
 

File đính kèm

Upvote 0
Bạn thao tác thử để phát hiện những vấn đề chưa tiện lợi;
Muốn sửa 1 dòng DL trên ListBox, lấy chuột bấm vô nó
Sửa dữ liệu (Ngành hàng, mã hàng, số lương, đơn giá & ghi chú
Bấm nút lưu DL sửa

Nút lưu toàn bộ hóa đơn đã vận hành; Muốn sửa 1 dòng trong hóa đơn đang là chưa được.
Chúc vui!


(Xin các bạn xem các file đính kèm ở những bài tiếp theo của mình, cảm ơn)
 
Lần chỉnh sửa cuối:
Upvote 0
Phiên bản mới nhất của 'QuanNhu' đây, xin mời những ai quan tâm

(Xin các bạn xem các file đính kèm ở những bài tiếp theo của mình, cảm ơn)
 
Lần chỉnh sửa cuối:
Upvote 0
Bổ sung các báo cáo tổng hợp:
1: Tổng hợp phiếu nhập của từng NCC (nhà cung cấp)
2. Tổng hợp phiếu xuất từng NCC đến từng đơn vị trong tháng

Xin các bạn xem file ở các bài tiếp theo bên dưới
 
Lần chỉnh sửa cuối:
Upvote 0
Phiên bản cải tiến mới nhất gồm:
1: Bỏ bớt 1 ComboBox liệt kê NCC (nhà cung cấp) & đem ComboBox còn lại ra Form (không còn để trên các Pages)
2. Khi chọn NCC trên ComboBox (vừa đem ra Form này) thì tr6n ComboBox phân loại mặt hàng chỉ liệt kê những loại hàng của NCC đã chọn này có.
 

File đính kèm

Upvote 0
Nhập thêm số liệu vô 'Nhap' để đa dạnh NCC & đa dạng ngày nhập số liệu
Sau mỗi lần nhập tiến hành chạy thử B/C
Hướng dẫn sử dụng:
Trước hết, muốn có B/c 1 ngày thì chọn số 1 trong CF (1)
Sau đó nhập ngày đầu ô ô dưới NCC & cuối cùng chọn NCC để có số liệu
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
file mới thêm HTnhap, bạn kiểm tra lại nha

Thay file lúc 19h30
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
bên cột NH hưởng e mặc định MB Sơn Tây thầy cố định luôn hay e tự đánh
Ở cột 'E' thuộc trang tính 'TTQT' vì nó đứng trước cột [TTien], nên macro làm mất sau mỗi lần nó chạy;
Có nhiều cách để sau khi chạy macro vẫn còn mệnh đề này; Sau đây mình hướng dẫn cách bạn sửa trong macro:
Trước tiên nhập cụm từ cần hiện trên dữ liệu BC của trang 'TTQP' vô 1 ô trống nào đó tại 'DMuc', như [P1];
Tiến hành gán cho nó cái tên 'ST' (hay gì, gì khác cũng được)
Sau đó vô CS VBE, mở macro này lên
PHP:
Private Sub CmdTTQT_Click()
  Dim W As Long, J As Long, Rws As Long, Dm As Integer
  Dim Arr(), Dict As Object
  Dim STay As String     '**    '
  
  Set Dict = CreateObject("Scripting.Dictionary")
  Sheets("TTQT").Select
  STay = Sheets("DMuc").Range("ST").Value    '**    '
  With Sheets("CSDL")
    Rws = .[b2].CurrentRegion.Rows.Count
    Arr() = .[b2].Resize(Rws, 9).Value
    ReDim dArr(1 To Rws, 1 To 6)
     [A9:F79].ClearContents:                                    Rows("9:79").Hidden = False
    For J = 1 To UBound(Arr())
        If IsEmpty(Arr(J, 2)) Then Exit For
        If Arr(J, 1) >= TxtToDat(Me!tbfDat.Value) And Arr(J, 1) <= TxtToDat(Me!tblDat.Value) Then
             If Not Dict.exists(Arr(J, 2)) Then
                W = W + 1:                                          Dict.Add Arr(J, 2), W
                dArr(W, 1) = W:                                     dArr(W, 6) = Arr(J, 9)
                For Dm = 2 To 3
                    dArr(W, Dm) = Arr(J, Dm)
                Next Dm
                dArr(W, 4) = "'" & Arr(J, 4)
                dArr(W, 5) = STay   '  **     '
            Else
                dArr(Dict.Item(Arr(J, 2)), 6) = dArr(Dict.Item(Arr(J, 2)), 6) + Arr(J, 9)
            End If
        End If
    Next J
  End With
  If W Then
    [A9].Resize(W, 6).Value = dArr()
  End If
  J = Switch(W < 10, 20, W < 16, 30, W < 30, 45, W < 50, 68, W < 72, W + 2)
  Rows(J & ":78").Hidden = True
  Sheets("TTQT").Select
End Sub

& Thêm các mệnh đề mới vô macro (những dòng có '** ' đó
(húc thành công nhiều!
 
Upvote 0
Còn đây là cặp đôi macro cha & con ở trrang 'NienHan' khi gộp file CapPhatQT vô file "Chuyen KT"

Dim dArr()
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [Af1]) Is Nothing Then
    Dim Thg As Byte, W As Integer, Rws As Long, J As Integer
    
    Thg = Choose(Target.Value, 1, 4, 7, 10, 35)
    Rws = [B59999].End(xlUp).Row + 9
    Range("A6:BE" & Rws).Clear
    For J = Thg To Thg + 2
        [B9999].End(xlUp).Offset(1).Value = "Tháng " & Right("0" & CStr(J), 2)
        THQuanTrang J
    Next J
 End If
End Sub
PHP:
Sub THQuanTrang(Thg As Integer)
 Dim Rws As Long, W As Integer, Col As Integer, J As Long
 Dim Arr(), Dict As Object
 Dim Tmp As String, TF As String
 
 Set Dict = CreateObject("Scripting.Dictionary")
 With Sheets("CSDL")
    Rws = .[B2].CurrentRegion.Rows.Count:                                       Arr() = .[B2].Resize(Rws, 9).Value
    ReDim dArr(1 To Rws, 1 To 55):                                                  ReDim sArr(1 To 1, 1 To 54)
    sArr(1, 1) = Sheets("DMuc").Range("GPE").Value                           ' Tiêng Viêt Tông Công    '
    For J = 1 To UBound(Arr())
        If Arr(J, 1) = "" Then Exit For
        If Month(Arr(J, 1)) = Thg Then
            Tmp = Arr(J, 2) & Arr(J, 5):                                                TF = Arr(J, 7)
            Col = Switch(TF = "AK_", 4, TF = "AM_", 6, TF = "Asn", 8, TF = "Atn", 10, TF = "AX_", 12, TF = "BL_", 14, TF = "BT_", 16, TF = "CH_", 18, TF = "CR_", 20, _
                    TF = "DL_", 22, TF = "Dn0", 24, TF = "Dn1", 26, TF = "GyT", 28, TF = "GyU", 30, TF = "KCR_", 32, TF = "KM_", 34, TF = "Mn_", 36, TF = "Mu_", 38, _
                        TF = "Qn_", 40, TF = "QP_", 42, TF = "QP1", 44, TF = "QP2", 46, TF = "Qtn", 48, TF = "RC_", 50, TF = "TL_", 52, TF = "VC_", 54)
            If Not Dict.exists(Tmp) Then
                W = W + 1:                                                                      Dict.Add Tmp, W
                dArr(W, 1) = W:                                                                dArr(W, 2) = Arr(J, 3)
                dArr(W, 3) = Arr(J, 5)
                dArr(W, Col) = Arr(J, 8):                                                   dArr(W, 1 + Col) = Arr(J, 9)
            Else
                 dArr(Dict.Item(Tmp), Col) = dArr(Dict.Item(Tmp), Col) + Arr(J, 8)
                dArr(Dict.Item(Tmp), 1 + Col) = dArr(Dict.Item(Tmp), 1 + Col) + Arr(J, 9)
            End If
            sArr(1, Col - 1) = sArr(1, Col - 1) + Arr(J, 8):                            sArr(1, Col) = sArr(1, Col) + Arr(J, 9)
        End If
    Next J
 End With
 If W = 0 Then Exit Sub
 Sheets("NienHan").[B9999].End(xlUp).Offset(1, -1).Resize(W, 55).Value = dArr()
 Sheets("NienHan").[B9999].End(xlUp).Offset(1).Resize(, 54).Value = sArr()
End Sub
 
Upvote 0
Đây là macro tạo báo cáo tháng trong file 'TangGia':
PHP:
Private Sub CmdBCT_Click()
 Dim Arr(), Cls As Range:                                       Dim Dm As Long, J As Long, Rws As Long
 Dim fDat As Date, lDat As Date, SLg1 As Double, SLgbc As Double, TT1 As Double, TTbc As Double
 
 fDat = TxTToDat(Me!tbfD.Value):                          lDat = TxTToDat(Me!tblD.Value)
 
 With Sheets("Nhap")
    Rws = .[B4].CurrentRegion.Rows.Count
    Arr() = .[B4].Resize(Rws, 8).Value
 End With
 Sheets("Nam").Select
 [i1].Value = fDat:                                                 [j1].Value = lDat
 For Each Cls In Range([b7], [B32].End(xlUp))
    For J = 1 To UBound(Arr())
        If Arr(J, 1) = "" Then Exit For
        If Arr(J, 2) = Cls.Value Then
            If Arr(J, 1) < fDat Then
                SLg1 = SLg1 + Arr(J, 6):                        TT1 = TT1 + Arr(J, 8)
            ElseIf Arr(J, 1) >= fDat And Arr(J, 1) <= lDat Then
                SLgbc = SLgbc + Arr(J, 6):                      TTbc = TTbc + Arr(J, 8)
            Else
            End If
        End If
    Next J
    Cls.Offset(, 3).Value = SLgbc:                          SLgbc = 0
    Cls.Offset(, 4).Value = TTbc:                           TTbc = 0
    Cls.Offset(, 7) = CStr(SLg1) & "; " & Str(TT1)
    SLg1 = 0:                                                       TT1 = 0
 Next Cls
End Sub
 
Upvote 0
Còn ca báo cáo tháng loại này là khó nên phải xài đến 2 dao mổ Dictionary:
PHP:
Private Sub CmdCT_Click()
 Dim Arr(), Dict As Object, Dic_ As Object
 Dim W As Integer, Z As Integer, J As Long, Rws As Long, Dm As Integer, fDat As Date, lDat As Date
On Error GoTo LoiCT
 Set Dict = CreateObject("Scripting.Dictionary")
 Set Dic_ = CreateObject("Scripting.Dictionary")
 lDat = Me!tbNCT.Value:                                 fDat = DateSerial(Year(lDat), Month(lDat), 1)
 With Sheets("Nhap")
    Rws = .[B4].CurrentRegion.Rows.Count:       Arr() = .[B4].Resize(Rws, 8).Value
  End With
  ReDim cArr(1 To 2, 1 To 26 * 3) As String
  ReDim dArr(1 To 31, 1 To 26 * 3)
  For J = 1 To UBound(Arr())
    If IsEmpty(Arr(J, 2)) Then Exit For
    If Arr(J, 1) >= fDat And Arr(J, 1) <= lDat Then
        If Not Dic_.exists(Arr(J, 2)) Then
            Z = Z + 1:                                          Dic_.Add Arr(J, 2), Z
            cArr(1, 3 * Z - 2) = Arr(J, 2):                 cArr(2, 3 * Z - 2) = "S Con"
            cArr(2, 3 * Z - 1) = "Sô Lg":                   cArr(2, 3 * Z) = "T Tiên":
        End If
        If Not Dict.exists(Arr(J, 1)) Then
            W = W + 1:                                      Dict.Add Arr(J, 1), W
            dArr(W, 1) = Arr(J, 1)
            For Dm = 1 To Z * 3 + 4 Step 3
                If cArr(1, Dm) <> "" Then
                    If cArr(1, Dm) = Arr(J, 2) Then
                        dArr(W, Dm + 1) = Arr(J, 5):    dArr(W, Dm + 2) = Arr(J, 6)
                        dArr(W, Dm + 3) = Arr(J, 8)
                    End If
                Else
                    Exit For
                End If
            Next Dm
        Else
            For Dm = 1 To Z * 3 + 4 Step 3
                If cArr(1, Dm) <> "" Then
                    If cArr(1, Dm) = Arr(J, 2) Then
                        dArr(Dict.Item(Arr(J, 1)), Dm + 1) = dArr(Dict.Item(Arr(J, 1)), Dm + 1) + Arr(J, 5)
                        dArr(Dict.Item(Arr(J, 1)), Dm + 2) = dArr(Dict.Item(Arr(J, 1)), Dm + 2) + Arr(J, 6)
                        dArr(Dict.Item(Arr(J, 1)), Dm + 3) = dArr(Dict.Item(Arr(J, 1)), Dm + 3) + Arr(J, 8)
                    End If
                Else
                    Exit For
                End If
            Next Dm
        End If
    End If
  Next J
  With Sheets("CTiet")
    .[A8].Resize(31, 3 * 25).ClearContents:         .[b6].Resize(2, 26 * 3).ClearContents
    If W Then
        .[b6].Resize(2, 3 * Z).Value = cArr():        .[A8].Resize(W, 3 * Z + 1).Value = dArr()
    End If
    .[S1].Value = Month(fDat):                          .Select
 End With
Err_:            Exit Sub
LoiCT:
    If Err = 9 Then
        Resume Next
    Else
        MsgBox Err
        Resume Err_
    End If
End Sub
 
Upvote 0
Để có thể xoay bảng báo cáo như theo hình (đính kèm) ta có thể nhờ macro này:
PHP:
Private Sub CmdBC__Click()
 Dim Arr(), Dict As Object, Dic_ As Object
 Dim W As Integer, Z As Integer, J As Long, Rws As Long, Dm As Integer, fDat As Date, lDat As Date
' On Error GoTo Loi_CT
 Set Dict = CreateObject("Scripting.Dictionary")
 Set Dic_ = CreateObject("Scripting.Dictionary")
 lDat = TxTToDat(Me!tbNCT.Value)
 fDat = DateSerial(Year(lDat), Month(lDat), 1)
 With Sheets("Nhap")
    Rws = .[B4].CurrentRegion.Rows.Count:       Arr() = .[B4].Resize(Rws, 8).Value
  End With
  ReDim cArr(1 To 2, 1 To 26 * 3) As Date
  ReDim dArr(1 To 26 * 3, 1 To 33)
 For J = 1 To UBound(Arr())
    If IsEmpty(Arr(J, 2)) Then Exit For
    If Arr(J, 1) >= fDat And Arr(J, 1) <= lDat Then
        If Not Dic_.exists(Arr(J, 1)) Then
            Z = Z + 1:                                          Dic_.Add Arr(J, 1), Z
            cArr(1, Z) = Arr(J, 1)
        End If
        If Not Dict.exists(Arr(J, 2)) Then
            If W = 0 Then W = 1 Else W = W + 3:     Dict.Add Arr(J, 2), W
            dArr(W, 1) = Arr(J, 2):                         dArr(W, 2) = "Sô Con"
            dArr(W + 1, 2) = "Sô Lg":                       dArr(W + 2, 2) = "T.Tiên"
            For Dm = 1 To Z
                If cArr(1, Dm) = Arr(J, 1) Then
                    dArr(W, Dm + 2) = Arr(J, 5):        dArr(W + 1, Dm + 2) = Arr(J, 6)
                    dArr(W + 2, Dm + 2) = Arr(J, 8)
                End If
            Next Dm
        Else
            For Dm = 1 To Z
                If cArr(1, Dm) = Arr(J, 1) Then
                    dArr(Dict.Item(Arr(J, 2)), Dm + 2) = dArr(Dict.Item(Arr(J, 2)), Dm + 2) + Arr(J, 5)
                    dArr(Dict.Item(Arr(J, 2)) + 1, Dm + 2) = dArr(Dict.Item(Arr(J, 2)) + 1, Dm + 2) + Arr(J, 6)
                    dArr(Dict.Item(Arr(J, 2)) + 2, Dm + 2) = dArr(Dict.Item(Arr(J, 2)) + 2, Dm + 2) + Arr(J, 8)
                End If
            Next Dm
        End If
    End If
 Next J
 With Sheets("BCT")
    .[c7].Resize(, 31).ClearContents:               .[A8].Resize(25 * 3, 35).ClearContents
    If W Then
        .[c7].Resize(, Z).Value = cArr():           .[A8].Resize(W + 3, Z + 2).Value = dArr()
        .[s1].Value = Month(Me!tbNCT.Value)
    End If
    .Select
 End With
Loi_CT:
End Sub



Mã ĐVNgày01/0603/0605/0607/0608/0609/0611/0613/0615/0617/06
D16Số Con
28​
Số Lg
29.5​
T.Tiên
973500​
D6_Số Con
1.5​
2​
Số Lg
148.8​
198​
T.Tiên
5959440​
7326000​
H4_Số Con
1​
Số Lg
101​
T.Tiên
3838000​
D5_Số Con
20​
Số Lg
24​
T.Tiên
912000​
H7_Số Con
13​
Số Lg
15.5​
T.Tiên
511500​
D8_Số Con
28​
Số Lg
29.5​
T.Tiên
973500​
D9_Số Con
1.5​
Số Lg
148.8​
T.Tiên
5959440​
D10Số Con
1​
Số Lg
101​
T.Tiên
3838000​
 
Upvote 0

Bài viết mới nhất

Back
Top Bottom