Gõ ngày Tự động tạo ngày tháng năm vùng cột F của Sheet , tên tháng chạy theo tên Sheet

Liên hệ QC
E

Excel my love_1

Thành viên thường trực
Tham gia
12/11/19
Bài viết
330
Được thích
183
Em chào các anh chị và các bạn của GPE. Ngày hè oi bức, ngồi văn phòng làm công việc nhập số liệu mà cũng toát mồ hôi
Em có 1 file theo dõi hóa đơn theo tháng, mỗi tháng 1 sheet riêng (có 12 sheet tương ứng từ tháng 1 đến tháng 12) của 1 năm. Cấu trúc các cột đều giống nhau ở 12 sheet
Em muốn
Tại mỗi sheet; Cột ngày tháng , cột F vùng từ F5:F500; Nếu gõ số ngày sẽ hiện đủ ra ngày/tháng/năm của kỳ theo tên sheet
Ví dụ: ở sheet Thang 1 ô F5 nhập 5 sẽ tự động thành 5/1/2020. Tương tự nếu ở các sheet khác thì sẽ tự động thành ngày /tháng / năm tương ứng tên Sheet (ví dụ sheet Thang 6!F10, gõ 15 sẽ thành 15/6/2020)
Lưu ý: ngày nhập vào ô phải nhỏ hơn số ngày theo chuẩn của các tháng. Ví dụ tháng 1 chỉ tối đa 31 ngày, tháng 2 là 28 ngày., tháng 4 30 ngày.....
ở mỗi sheet em có làm 1 code nhưng mà không ra kết quả
Mã: 
Sub autodate_month1()
' Ap dụng cho Sheet Thang 1'
If Not Intersect(Target, [F3:F500]) Is Nothing _
And Target <> "" And Target.Value <= 31 Then
Buf = Target.Value
    Target = DateSerial(2020, 1, Target) 'MONTH follow name of Sheet
Else
            MsgBox "Thang 1 khong co ngay " & Buf
            Target = ""
End If
End Sub
Em gửi file mong các anh chị và các bạn giúp đỡ để ra kết quả mong muốn
Em cảm ơn các anh chị và các bạn đã quan tâm đến bài này
 

File đính kèm

  • BAN RA 2020.xlsb
    127.4 KB · Đọc: 14
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Xóa toàn bộ code của bạn, copy code sau vào ThisWorkbook.
Mã: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Const lYear As Long = 2020
Dim lMonth As Long, Cll As Range, CllVal As Variant, dDate As Date, sMsg As String
Set Target = Intersect(Target, Sh.[F3:F500])
If Not Target Is Nothing Then
    lMonth = CLng(Right(Sh.Name, 2))
    Application.EnableEvents = False
    For Each Cll In Target.Cells
        CllVal = Cll.Value2
        If IsNumeric(CllVal) Then
            CllVal = CLng(CllVal)
            If CllVal > 0 And CllVal <= 31 Then
                dDate = VBA.DateSerial(lYear, lMonth, CllVal)
                If Day(dDate) <> CllVal Then
                    sMsg = "Thang " & lMonth & " khong co ngay " & CllVal
                Else
                    Cll.Value2 = dDate
                End If
            ElseIf Year(CllVal) <> lYear Or Month(CllVal) <> lMonth Then
                sMsg = "Du lieu khong hop le"
            End If
        Else
            sMsg = "Chi duoc nhap so hoac ngay thang o day"
        End If
        If sMsg <> "" Then
            MsgBox sMsg
            Cll.ClearContents
            sMsg = ""
        End If
    Next
    Application.EnableEvents = True
End If
End Sub
 
Upvote 0
huuthang_bd đã viết:
Xóa toàn bộ code của bạn, copy code sau vào ThisWorkbook.
Mã: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Const lYear As Long = 2020
Dim lMonth As Long, Cll As Range, CllVal As Variant, dDate As Date, sMsg As String
Set Target = Intersect(Target, Sh.[F3:F500])
If Not Target Is Nothing Then
    lMonth = CLng(Right(Sh.Name, 2))
    Application.EnableEvents = False
    For Each Cll In Target.Cells
        CllVal = Cll.Value2
        If IsNumeric(CllVal) Then
            CllVal = CLng(CllVal)
            If CllVal > 0 And CllVal <= 31 Then
                dDate = VBA.DateSerial(lYear, lMonth, CllVal)
                If Day(dDate) <> CllVal Then
                    sMsg = "Thang " & lMonth & " khong co ngay " & CllVal
                Else
                    Cll.Value2 = dDate
                End If
            ElseIf Year(CllVal) <> lYear Or Month(CllVal) <> lMonth Then
                sMsg = "Du lieu khong hop le"
            End If
        Else
            sMsg = "Chi duoc nhap so hoac ngay thang o day"
        End If
        If sMsg <> "" Then
            MsgBox sMsg
            Cll.ClearContents
            sMsg = ""
        End If
    Next
    Application.EnableEvents = True
End If
End Sub
Nhấp chuột vào đây để mở rộng...
Anh ơi! em đã chèn các code này vào các sheet. Nhưng mà khi nhập số vào vùng cột F ở các sheet thì kết quả lại không như mong muốn anh à. Ví dụ ở sheet Thang 3 em nhập 15 vào ô F5 , ấn Enter thì nó nhảy ra là 15/01/1900 chứ không phải là 15/03/2020. Em gửi lại file đã chứa code của anh. Anh xem giúp em với ạ. Em cảm ơn anh nhiều nhiềuUntitled.png
 

File đính kèm

  • BAN RA 2020-.xlsb
    127.7 KB · Đọc: 5
Upvote 0
Excel my love_1 đã viết:
Anh ơi! em đã chèn các code này vào các sheet. Nhưng mà khi nhập số vào vùng cột F ở các sheet thì kết quả lại không như mong muốn anh à. Ví dụ ở sheet Thang 3 em nhập 15 vào ô F5 , ấn Enter thì nó nhảy ra là 15/01/1900 chứ không phải là 15/03/2020. Em gửi lại file đã chứa code của anh. Anh xem giúp em với ạ. Em cảm ơn anh nhiều nhiềuView attachment 239463
Nhấp chuột vào đây để mở rộng...
Bạn không làm đúng hướng dẫn của bài #3.
huuthang_bd đã viết:
Xóa toàn bộ code của bạn, copy code sau vào ThisWorkbook.
Nhấp chuột vào đây để mở rộng...
Xóa toàn bộ code trong các (12) sheet của bạn. (tránh gây lỗi)
Thực hiện lại theo hướng dẫn:" copy code sau vào ThisWorkbook."
 
Upvote 0
Ba Tê đã viết:
Bạn không làm đúng hướng dẫn của bài #3.

Xóa toàn bộ code trong các (12) sheet của bạn. (tránh gây lỗi)
Thực hiện lại theo hướng dẫn.
Nhấp chuột vào đây để mở rộng...
Em cảm ơn anh, em hiểu rồi ạ.
Bài đã được tự động gộp:

huuthang_bd đã viết:
Xóa toàn bộ code của bạn, copy code sau vào ThisWorkbook.
Mã: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Const lYear As Long = 2020
Dim lMonth As Long, Cll As Range, CllVal As Variant, dDate As Date, sMsg As String
Set Target = Intersect(Target, Sh.[F3:F500])
If Not Target Is Nothing Then
    lMonth = CLng(Right(Sh.Name, 2))
    Application.EnableEvents = False
    For Each Cll In Target.Cells
        CllVal = Cll.Value2
        If IsNumeric(CllVal) Then
            CllVal = CLng(CllVal)
            If CllVal > 0 And CllVal <= 31 Then
                dDate = VBA.DateSerial(lYear, lMonth, CllVal)
                If Day(dDate) <> CllVal Then
                    sMsg = "Thang " & lMonth & " khong co ngay " & CllVal
                Else
                    Cll.Value2 = dDate
                End If
            ElseIf Year(CllVal) <> lYear Or Month(CllVal) <> lMonth Then
                sMsg = "Du lieu khong hop le"
            End If
        Else
            sMsg = "Chi duoc nhap so hoac ngay thang o day"
        End If
        If sMsg <> "" Then
            MsgBox sMsg
            Cll.ClearContents
            sMsg = ""
        End If
    Next
    Application.EnableEvents = True
End If
End Sub
Nhấp chuột vào đây để mở rộng...
Em làm được rồi ạ. Em cảm ơn anh nhiều
 
Upvote 0
Excel my love_1 đã viết:
Em chào các anh chị và các bạn của GPE. Ngày hè oi bức, ngồi văn phòng làm công việc nhập số liệu mà cũng toát mồ hôi
Em có 1 file theo dõi hóa đơn theo tháng, mỗi tháng 1 sheet riêng (có 12 sheet tương ứng từ tháng 1 đến tháng 12) của 1 năm. Cấu trúc các cột đều giống nhau ở 12 sheet
Em muốn
Tại mỗi sheet; Cột ngày tháng , cột F vùng từ F5:F500; Nếu gõ số ngày sẽ hiện đủ ra ngày/tháng/năm của kỳ theo tên sheet
Ví dụ: ở sheet Thang 1 ô F5 nhập 5 sẽ tự động thành 5/1/2020. Tương tự nếu ở các sheet khác thì sẽ tự động thành ngày /tháng / năm tương ứng tên Sheet (ví dụ sheet Thang 6!F10, gõ 15 sẽ thành 15/6/2020)
Lưu ý: ngày nhập vào ô phải nhỏ hơn số ngày theo chuẩn của các tháng. Ví dụ tháng 1 chỉ tối đa 31 ngày, tháng 2 là 28 ngày., tháng 4 30 ngày.....
ở mỗi sheet em có làm 1 code nhưng mà không ra kết quả
Mã: 
Sub autodate_month1()
' Ap dụng cho Sheet Thang 1'
If Not Intersect(Target, [F3:F500]) Is Nothing _
And Target <> "" And Target.Value <= 31 Then
Buf = Target.Value
    Target = DateSerial(2020, 1, Target) 'MONTH follow name of Sheet
Else
            MsgBox "Thang 1 khong co ngay " & Buf
            Target = ""
End If
End Sub
Em gửi file mong các anh chị và các bạn giúp đỡ để ra kết quả mong muốn
Em cảm ơn các anh chị và các bạn đã quan tâm đến bài này
Nhấp chuột vào đây để mở rộng...
À Anh ơi trong quá trình sử dụng , em thấy có cái này hơi kỳ kỳ, đó là khi em nhập ngày xong ở 1 ô cột F của sheet. Nếu em ấn Delete cái ngày đó ở ô đó thì lại hiện cảnh báo "Du lieu khong hop le"
Có cách nào khắc phục tình trạng này không anh?Untitled.png
 

File đính kèm

  • BAN RA 2020- - Copy.xlsb
    130.7 KB · Đọc: 7
Upvote 0
Bạn dùng code này.
Mã: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Const lYear As Long = 2020
Dim lMonth As Long, Cll As Range, CllVal As Variant, dDate As Date, sMsg As String
Set Target = Intersect(Target, Sh.[F3:F500])
If Not Target Is Nothing Then
    lMonth = CLng(Right(Sh.Name, 2))
    Application.EnableEvents = False
    For Each Cll In Target.Cells
        CllVal = Cll.Value2
        If Not IsEmpty(CllVal) Then
            If IsNumeric(CllVal) Then
                CllVal = CLng(CllVal)
                If CllVal > 0 And CllVal <= 31 Then
                    dDate = VBA.DateSerial(lYear, lMonth, CllVal)
                    If Day(dDate) <> CllVal Then
                        sMsg = "Thang " & lMonth & " khong co ngay " & CllVal
                    Else
                        Cll.Value2 = dDate
                    End If
                ElseIf Year(CllVal) <> lYear Or Month(CllVal) <> lMonth Then
                    sMsg = "Du lieu khong hop le"
                End If
            Else
                sMsg = "Chi duoc nhap so hoac ngay thang o day"
            End If
        End If
        If sMsg <> "" Then
            MsgBox sMsg
            Cll.ClearContents
            sMsg = ""
        End If
    Next
    Application.EnableEvents = True
End If
End Sub
 
Upvote 0
huuthang_bd đã viết:
Bạn dùng code này.
Mã: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Const lYear As Long = 2020
Dim lMonth As Long, Cll As Range, CllVal As Variant, dDate As Date, sMsg As String
Set Target = Intersect(Target, Sh.[F3:F500])
If Not Target Is Nothing Then
    lMonth = CLng(Right(Sh.Name, 2))
    Application.EnableEvents = False
    For Each Cll In Target.Cells
        CllVal = Cll.Value2
        If Not IsEmpty(CllVal) Then
            If IsNumeric(CllVal) Then
                CllVal = CLng(CllVal)
                If CllVal > 0 And CllVal <= 31 Then
                    dDate = VBA.DateSerial(lYear, lMonth, CllVal)
                    If Day(dDate) <> CllVal Then
                        sMsg = "Thang " & lMonth & " khong co ngay " & CllVal
                    Else
                        Cll.Value2 = dDate
                    End If
                ElseIf Year(CllVal) <> lYear Or Month(CllVal) <> lMonth Then
                    sMsg = "Du lieu khong hop le"
                End If
            Else
                sMsg = "Chi duoc nhap so hoac ngay thang o day"
            End If
        End If
        If sMsg <> "" Then
            MsgBox sMsg
            Cll.ClearContents
            sMsg = ""
        End If
    Next
    Application.EnableEvents = True
End If
End Sub
Nhấp chuột vào đây để mở rộng...
Code đã khắc phục được tình trạng trên rồi ạ. Em cảm ơn anh
 
Upvote 0
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

nguyen trung cuong
File chứa marco không mở được.
Trả lời
3
Đọc
79
hvnhpro
H
hoaithanh9480
KIỂM PHIẾU BẦU ĐẠI HỘI ĐẢNG
    • Thích
    • Cười
Trả lời
1
Đọc
30
hvnhpro
H
F
  • Question
Nhờ tư vấn cách tạo QR trong Excel
Trả lời
6
Đọc
500
anhtuanle123
A
Tienvinh191
  • Question
Nhờ viết Code lấy dữ liệu tờ khai hải quan vào bảng tổng hợp
2
Trả lời
25
Đọc
2K
haott
H
H
Hỗ trợ lấy danh sách dữ liệu thỏa mãn điều kiện
Trả lời
2
Đọc
92
NT Ngoc Yen
N
CodyPham97
tạo biểu tượng thay thế nhấn đúp chuột
Trả lời
4
Đọc
87
phansythao
phansythao
dovanha1994
Giúp e tìm nguyên nhân sai và hướng dẫn e đọc file này với ạ
    • Phẫn nộ
Trả lời
4
Đọc
117
SA_DQ
SA_DQ
20050911
File Excel lỗi ''The file could not be accessed. Try one of the following:.."
Trả lời
10
Đọc
523
20050911
20050911
N
Giúp sửa mã code
2
Trả lời
20
Đọc
451
Nguyễn Diêu Hiền
N
GPE-Trợ Lý
MỪNG NGÀY NHÀ GIÁO VIỆT NAM 20/11/2024
    • Thích
    • Yêu thích
Trả lời
1
Đọc
87
SA_DQ
SA_DQ
Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
2
Trả lời
32
Đọc
858
VetMini
V
K
Nhờ mọi người hoàn thiện giúp công thức
Trả lời
4
Đọc
108
kiendt1973
K
P
Nhờ giúp đỡ hàm lọc dữ liệu theo tỉnh
Trả lời
10
Đọc
170
Parabol
P
H
Chúc mừng 20/11- ngày tôn vinh nhà giáo Việt Nam.
    • Thích
    • Yêu thích
Trả lời
0
Đọc
65
HUONGHCKT
H
N
Vẽ biểu đồ kết hợp nhiều yếu tố trong excel
Trả lời
7
Đọc
197
Ny Ny 2024
N
Nhật Anh 9x
  • Question
Tính tồn cuối kỳ luỹ kế cho nhiều mã
Trả lời
2
Đọc
104
Nhật Anh 9x
Nhật Anh 9x
C
Chia sẻ: Kết quả xổ số Keno
    • Cười
    • Thích
2
Trả lời
20
Đọc
586
ptm0412
ptm0412
huynhnhu1234
Tìm giá vé máy bay một chiều và khứ hồi
Trả lời
1
Đọc
117
hvnhpro
H
nobita994
Trừ số lượng dần theo dòng khi quét Sumif tổng có tên sản phẩm bị trùng.
Trả lời
2
Đọc
88
bebo021999
B
PhanTuHuong
Bàn về môn thể thao bóng bàn nào!
    • Thích
    • Yêu thích
    • Cười
2
Trả lời
37
Đọc
2K
cantl
C
Xem thêm…

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