Trợ giúp vấn đề tạo Form thông báo thuốc sắp hết hạn và hết hạn. (1 người xem)

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

lexuantruong

Thành viên chính thức
Tham gia
27/11/08
Bài viết
65
Được thích
3
Nhà thuốc của em hiện rất nhiều thuốc nên không có thời gian để dò từng thuốc xem thuốc nào "sắp hết hạn" hay thuốc nào "hết hạn" cả. Anh (chị) có thể tạo giúp code cho Forms ( đã tạo sẵn trong file) với được không ạ.
Khi mở excel lên thì sẽ hiện forms thông báo những thông tin thuốc như trong Forms ( xem trong file đính kèm).
Về "ngày/tháng/năm" những thuốc "hết hạn" hay "sắp hết hạn" chỉ cần dò theo " tháng/năm" không cần dò " ngày".
VD: thuốc có hạn dùng là 15/10/2014 thì chỉ cần tới tháng 10/2014 là Forms sẽ thông báo trong tab "sắp hết hạn", nếu qua tháng 11/2014 thì sẽ hiện bên tab " hết hạn".
Nhờ anh (chị) giúp,e xin cảm ơn trước ^^.
 

File đính kèm

Nhà thuốc của em hiện rất nhiều thuốc nên không có thời gian để dò từng thuốc xem thuốc nào "sắp hết hạn" hay thuốc nào "hết hạn" cả. Anh (chị) có thể tạo giúp code cho Forms ( đã tạo sẵn trong file) với được không ạ.
Khi mở excel lên thì sẽ hiện forms thông báo những thông tin thuốc như trong Forms ( xem trong file đính kèm).
Về "ngày/tháng/năm" những thuốc "hết hạn" hay "sắp hết hạn" chỉ cần dò theo " tháng/năm" không cần dò " ngày".
VD: thuốc có hạn dùng là 15/10/2014 thì chỉ cần tới tháng 10/2014 là Forms sẽ thông báo trong tab "sắp hết hạn", nếu qua tháng 11/2014 thì sẽ hiện bên tab " hết hạn".
Nhờ anh (chị) giúp,e xin cảm ơn trước ^^.

Theo ý của mình thì nên sort cột ngày hạn sử dụng, dùng công thức bình thường là kiểm tra được rồi. Lấy ngày hết hạn trừ hàm Today() sẽ biết liền mà
 
Upvote 0
Theo ý của mình thì nên sort cột ngày hạn sử dụng, dùng công thức bình thường là kiểm tra được rồi. Lấy ngày hết hạn trừ hàm Today() sẽ biết liền mà
danh mục thuốc rất nhiều và sắp xếp theo ABC, nếu như sort thì hạn sử dung của thuốc sẽ không đúng rồi, lẫn lộn qua những thuốc khác mất, ý của em là khi mở excel lên sẽ hiện Foms thông báo những thuốc " sắp hết hạn", hoặc là tạo thêm 1 nút buttom ở Sheet1 khi click vào đó sẽ hiện Forms thông báo lên, như vậy để dễ quản lý hơn là dò từng hàng một.
 
Upvote 0
danh mục thuốc rất nhiều và sắp xếp theo ABC, nếu như sort thì hạn sử dung của thuốc sẽ không đúng rồi, lẫn lộn qua những thuốc khác mất, ý của em là khi mở excel lên sẽ hiện Foms thông báo những thuốc " sắp hết hạn", hoặc là tạo thêm 1 nút buttom ở Sheet1 khi click vào đó sẽ hiện Forms thông báo lên, như vậy để dễ quản lý hơn là dò từng hàng một.
Tạo thêm 1 cột thứ tự, khi nào cần thì sort ngược trở lại
 
Upvote 0
1/ theo yêu cầu (chưa thử, bạn kiểm tra, chỉnh sửa tùy ý)
Mã:
Private Sub UserForm_Activate()
    Dim LastRow&, i&, j&
    ListSapHetHan.Clear
    ListHetHan.Clear
    LastRow = Sheet1.UsedRange.Row + Sheet1.UsedRange.Rows.Count - 1
    For i = 2 To LastRow
        If DateDiff("d", Date, .Cells(i, 6)) < 30 Then
            With ListSapHetHan
                .AddItem
                For j = 1 To 5
                    .List(.ListCount - 1, j) = Sheet1.Cells(i, j)
                Next j
            End With
        ElseIf DateDiff("d", Date, .Cells(i, 6)) < 30 Then
            With ListHetHan
                .AddItem
                For j = 1 To 5
                    .List(.ListCount - 1, j) = Sheet1.Cells(i, j)
                Next j
            End With
        End If
    Next
End Sub
2/ tui lại thích thế này hơn: tô màu chữ chứ không tạo userform (xem file đính kèm)
Mã:
Private Sub cmdCheck_Click()
    Dim LastRow&, i&
    LastRow = Sheet1.UsedRange.Row + Sheet1.UsedRange.Rows.Count - 1
    With Sheet1
        For i = 2 To LastRow
            If IsDate(.Cells(i, 6)) Then
                If DateDiff("d", Date, .Cells(i, 6)) < 30 Then
                    .Cells(i, 6).Font.Color = vbGreen
                ElseIf DateDiff("d", Date, .Cells(i, 6)) < 30 Then
                    .Cells(i, 6).Font.Color = vbRed
                End If
            End If
        Next
    End With
End Sub
P/S: ở đây tui xem “sắp hết hạn” là trong vòng 30 ngày, bạn sửa lại số ngày cho phù hợp với thực tế.
kiểm tra mấy cái IF cẩn thận, kẻo lộn. đại loại vậy.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
1/ theo yêu cầu (chưa thử, bạn kiểm tra, chỉnh sửa tùy ý)
Mã:
Private Sub UserForm_Activate()
    Dim LastRow&, i&, j&
    ListSapHetHan.Clear
    ListHetHan.Clear
    LastRow = Sheet1.UsedRange.Row + Sheet1.UsedRange.Rows.Count - 1
    For i = 2 To LastRow
        If DateDiff("d", Date, .Cells(i, 6)) < 30 Then
            With ListSapHetHan
                .AddItem
                For j = 1 To 5
                    .List(.ListCount - 1, j) = Sheet1.Cells(i, j)
                Next j
            End With
        ElseIf DateDiff("d", Date, .Cells(i, 6)) < 30 Then
            With ListHetHan
                .AddItem
                For j = 1 To 5
                    .List(.ListCount - 1, j) = Sheet1.Cells(i, j)
                Next j
            End With
        End If
    Next
End Sub
Code bị lỗi rồi, a kiểm tra lại giúp e với-+*/
2/ tui lại thích thế này hơn: tô màu chữ chứ không tạo userform (xem file đính kèm)
Mã:
Private Sub cmdCheck_Click()
    Dim LastRow&, i&
    LastRow = Sheet1.UsedRange.Row + Sheet1.UsedRange.Rows.Count - 1
    With Sheet1
        For i = 2 To LastRow
            If IsDate(.Cells(i, 6)) Then
                If DateDiff("d", Date, .Cells(i, 6)) < 30 Then
                    .Cells(i, 6).Font.Color = vbGreen
                ElseIf DateDiff("d", Date, .Cells(i, 6)) < 30 Then
                    .Cells(i, 6).Font.Color = vbRed
                End If
            End If
        Next
    End With
End Sub
P/S: ở đây tui xem “sắp hết hạn” là trong vòng 30 ngày, bạn sửa lại số ngày cho phù hợp với thực tế.
kiểm tra mấy cái IF cẩn thận, kẻo lộn. đại loại vậy.
Thuốc rất nhiều, danh sách đến hơn 1000 thuốc, ngồi dò màu chữ thì rất mệt,e chỉ đưa file ví dụ lên thôi, e vẫn thích cái Foms liệt kê danh sách thuốc hơn. Chỉ cần mở excel lên là nó liệt kê như trong Forms (xem file) những thuốc gần hết hạn hoặc hết hạn, như vậy thì dễ quản lý hơn. Mong dc a giúp đỡ/-*+/
 
Upvote 0
Bữa trước viết đại ý thôi, tưởng bạn kiểm tra được và sửa chứ. Làm thật thì lắm thứ lắm, thôi đã chót thì chét vậy. (tui cũng bận lắm, thỉnh thoảng mới vô diễn đàn)
Đây là code đã sửa:
Mã:
Option Explicit
 
Private Sub UserForm_Activate()
    Dim LastRow&, i&, j&
    ListSapHetHan.Clear
    ListHetHan.Clear
    LastRow = Sheet1.UsedRange.Row + Sheet1.UsedRange.Rows.Count - 1
    For i = [COLOR=#ff0000][B]2[/B][/COLOR] To LastRow
        If Sheet1.Cells(i, 6) <> vbNullString Then
            If IsDate(Sheet1.Cells(i, 6)) Then
                If DateDiff("d", Date, Sheet1.Cells(i, 6)) < 0 Then
                    With ListHetHan
                        .AddItem
                        For j = 1 To 5
                            .List(.ListCount - 1, j - 1) = Sheet1.Cells(i, j)
                        Next j
                        .List(.ListCount - 1, 5) = Format(Sheet1.Cells(i, j), "dd/mm/yyyy")
                    End With
                ElseIf DateDiff("d", Date, Sheet1.Cells(i, 6)) < 30 Then
                    With ListSapHetHan
                        .AddItem
                        For j = 1 To 5
                            .List(.ListCount - 1, j - 1) = Sheet1.Cells(i, j)
                        Next j
                        .List(.ListCount - 1, 5) = Format(Sheet1.Cells(i, j), "dd/mm/yyyy")
                    End With
                End If
            End If
        End If
    Next
End Sub

P/S: Trong file đính kèm sửa for i = 14 to ... thành for i = 2 to ... nhé.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Thanks a jack nt nhiều nhiều@$@!^%, code chạy rất tốt, còn 1 vấn đề phát sinh này nữa a giúp e với.
Khi Merge Cells 2 ô lại với nhau làm 1 thì Forms không hiển thị được cột "Tên thuốc" và cột " Đơn vị" ( xem trong file).
a có cách nào để forms hiển thị đầy đủ k?
 

File đính kèm

Upvote 0
Thanks a jack nt nhiều nhiều@$@!^%, code chạy rất tốt, còn 1 vấn đề phát sinh này nữa a giúp e với.
Khi Merge Cells 2 ô lại với nhau làm 1 thì Forms không hiển thị được cột "Tên thuốc" và cột " Đơn vị" ( xem trong file).
a có cách nào để forms hiển thị đầy đủ k?
Here you are:
(Cái chỗ màu đỏ có nghĩa là: ô đầu tiên của vùng merge.)

Mã:
Private Sub UserForm_Activate()
    Dim LastRow&, i&, j&
    ListSapHetHan.Clear
    ListHetHan.Clear
    LastRow = Sheet1.UsedRange.Row + Sheet1.UsedRange.Rows.Count - 1
    For i = 2 To LastRow
        If Sheet1.Cells(i, 6) <> vbNullString Then
            If IsDate(Sheet1.Cells(i, 6)) Then
                If DateDiff("d", Date, Sheet1.Cells(i, 6)) < 0 Then
                    With ListHetHan
                        .AddItem
                        For j = 1 To 5
                            .List(.ListCount - 1, j - 1) = Sheet1.Cells(i, j)[COLOR=#ff0000].MergeArea.Cells(1)[/COLOR]
                        Next j
                        .List(.ListCount - 1, 5) = Format(Sheet1.Cells(i, j), "dd/mm/yyyy")
                    End With
                ElseIf DateDiff("d", Date, Sheet1.Cells(i, 6)) < 30 Then
                    With ListSapHetHan
                        .AddItem
                        For j = 1 To 5
                            .List(.ListCount - 1, j - 1) = Sheet1.Cells(i, j)[COLOR=#ff0000].MergeArea.Cells(1)[/COLOR]
                        Next j
                        .List(.ListCount - 1, 5) = Format(Sheet1.Cells(i, j), "dd/mm/yyyy")
                    End With
                End If
            End If
        End If
    Next
End Sub

(Xem cái 3.2 đính kèm)
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Here you are:
(Cái chỗ màu đỏ có nghĩa là: ô đầu tiên của vùng merge.)

Mã:
Private Sub UserForm_Activate()
    Dim LastRow&, i&, j&
    ListSapHetHan.Clear
    ListHetHan.Clear
    LastRow = Sheet1.UsedRange.Row + Sheet1.UsedRange.Rows.Count - 1
    For i = 2 To LastRow
        If Sheet1.Cells(i, 6) <> vbNullString Then
            If IsDate(Sheet1.Cells(i, 6)) Then
                If DateDiff("d", Date, Sheet1.Cells(i, 6)) < 0 Then
                    With ListHetHan
                        .AddItem
                        For j = 1 To 5
                            .List(.ListCount - 1, j - 1) = Sheet1.Cells(i, j)[COLOR=#ff0000].MergeArea.Cells(1)[/COLOR]
                        Next j
                        .List(.ListCount - 1, 5) = Format(Sheet1.Cells(i, j), "dd/mm/yyyy")
                    End With
                ElseIf DateDiff("d", Date, Sheet1.Cells(i, 6)) < 30 Then
                    With ListSapHetHan
                        .AddItem
                        For j = 1 To 5
                            .List(.ListCount - 1, j - 1) = Sheet1.Cells(i, j)[COLOR=#ff0000].MergeArea.Cells(1)[/COLOR]
                        Next j
                        .List(.ListCount - 1, 5) = Format(Sheet1.Cells(i, j), "dd/mm/yyyy")
                    End With
                End If
            End If
        End If
    Next
End Sub

(Xem cái 3.2 đính kèm)

đã giải quyết dc vấn đề. Cảm ơn a jack nt đã giúp đỡ e rất nhiều
 
Upvote 0

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

Back
Top Bottom