Code tính tuổi chính xác. Nhưng phải làm sao để nó không tính những ô ở cột G không có dữ liệu. (1 người xem)

Liên hệ QC

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

hoahongden142917

Thành viên hoạt động
Tham gia
28/5/13
Bài viết
180
Được thích
20
Mình mới sưu tầm được 1 Code tính tuổi chính xác. Nhưng phải làm sao để nó không tính những ô ở cột G không có dữ liệu mà chỉ tính tuổi ở các ô G có dữ liệu thôi. Nhờ các anh chị chỉ giáo. Vì vùng làm việc của mình nó bị gián đoạn. Cụ thể từ vùng G4 đến G10 có dữ liệu, nhưng cũng có thể G50 đến G58 lại có dữ liệu nữa và có thể có dữ liệu gián đoạn đến ô G1088
Xin cảm ơn.

Sub tuoi()
Dim b As Date
Dim k As Integer
For k = 1 To 1088
b = Sheets("sheet1").Range("G4").Offset(k - 1, 0).Value

Dim d As Integer
On Error Resume Next
d1 = Day(Date)

d2 = Day(b)
m1 = Month(Date)
m2 = Month(b)
y1 = Year(Date)
y2 = Year(b)

If m1 > m2 Then
d = y1 - y2
ElseIf (m1 >= m2 And d1 >= d2) Then
d = y1 - y2
Else: d = y1 - y2 - 1

End If

Sheets("sheet1").Range("H4").Offset(k - 1, 0).Value = d

Next
End Sub
 

File đính kèm

thêm if
Rich (BB code):
Sub tuoi()
...
For k = 1 To 1088
b = Sheets("sheet1").Range("G4").Offset(k - 1, 0).Value
If Len(b) > 0 Then
...
Sheets("sheet1").Range("H4").Offset(k - 1, 0).Value = d
End If
Next
End Sub
Code lủng củng quá!
 
Mình mới sưu tầm được 1 Code tính tuổi chính xác. Nhưng phải làm sao để nó không tính những ô ở cột G không có dữ liệu mà chỉ tính tuổi ở các ô G có dữ liệu thôi. Nhờ các anh chị chỉ giáo. Vì vùng làm việc của mình nó bị gián đoạn. Cụ thể từ vùng G4 đến G10 có dữ liệu, nhưng cũng có thể G50 đến G58 lại có dữ liệu nữa và có thể có dữ liệu gián đoạn đến ô G1088
Xin cảm ơn.
Nếu tính tuổi thì dùng công thức để tính cho lẹ, bạn nghĩ sao?
PHP:
=TEXT(TODAY()-G4,"yy")
 
Mình mới sưu tầm được 1 Code tính tuổi chính xác. Nhưng phải làm sao để nó không tính những ô ở cột G không có dữ liệu mà chỉ tính tuổi ở các ô G có dữ liệu thôi. Nhờ các anh chị chỉ giáo. Vì vùng làm việc của mình nó bị gián đoạn. Cụ thể từ vùng G4 đến G10 có dữ liệu, nhưng cũng có thể G50 đến G58 lại có dữ liệu nữa và có thể có dữ liệu gián đoạn đến ô G1088
Xin cảm ơn.

Sub tuoi()
Dim b As Date
Dim k As Integer
For k = 1 To 1088
b = Sheets("sheet1").Range("G4").Offset(k - 1, 0).Value

Dim d As Integer
On Error Resume Next
d1 = Day(Date)

d2 = Day(b)
m1 = Month(Date)
m2 = Month(b)
y1 = Year(Date)
y2 = Year(b)

If m1 > m2 Then
d = y1 - y2
ElseIf (m1 >= m2 And d1 >= d2) Then
d = y1 - y2
Else: d = y1 - y2 - 1

End If

Sheets("sheet1").Range("H4").Offset(k - 1, 0).Value = d

Next
End Sub
Chạy code
Mã:
Sub tuoi()
  Dim b, y As Long, k As Long, d As Long
  y = Year(Date)
  For k = 4 To 100
    b = Sheets("sheet1").Range("G" & k).Value
    If b <> Empty And IsDate(b) Then
      d = y - Year(b)
      If DateSerial(y, Month(b), Day(b)) > Date Then d = d - 1
      Sheets("sheet1").Range("H" & k).Value = d
    End If
  Next
End Sub
 
Từ bài số #3 ta viết code nó đơn giản như sau:

PHP:
Sub TinhTuoi()
    Dim e As Long
    Dim rngDate As Range
    e = Sheets("sheet1").Range("C" & Rows.Count).End(xlUp).Row
    For Each rngDate In Sheets("sheet1").Range("G4:G" & e)
        rngDate.Offset(, 1).Value = Format(Date - rngDate.Value, "yy")
    Next
End Sub

Không rắc rối gì cả!
 
thêm if
Rich (BB code):
Sub tuoi()
...
For k = 1 To 1088
b = Sheets("sheet1").Range("G4").Offset(k - 1, 0).Value
If Len(b) > 0 Then
...
Sheets("sheet1").Range("H4").Offset(k - 1, 0).Value = d
End If
Next
End Sub
Code lủng củng quá
xin cảm ơn bạn rất nhiều
Bài đã được tự động gộp:

Nếu tính tuổi thì dùng công thức để tính cho lẹ, bạn nghĩ sao?
PHP:
=TEXT(TODAY()-G4,"yy")
chậm bạn ơi. vì dữ liệu lớn lắm
Bài đã được tự động gộp:

Chạy code
Mã:
Sub tuoi()
  Dim b, y As Long, k As Long, d As Long
  y = Year(Date)
  For k = 4 To 100
    b = Sheets("sheet1").Range("G" & k).Value
    If b <> Empty And IsDate(b) Then
      d = y - Year(b)
      If DateSerial(y, Month(b), Day(b)) > Date Then d = d - 1
      Sheets("sheet1").Range("H" & k).Value = d
    End If
  Next
End Sub
Mình xin cảm ơn bạn nhiều.
Bài đã được tự động gộp:

thêm if
Rich (BB code):
Sub tuoi()
...
For k = 1 To 1088
b = Sheets("sheet1").Range("G4").Offset(k - 1, 0).Value
If Len(b) > 0 Then
...
Sheets("sheet1").Range("H4").Offset(k - 1, 0).Value = d
End If
Next
End Sub
Code lủng củng quá!
nó vẫn tính luôn các ô không có dữ liệu.
Bài đã được tự động gộp:

Chạy code
Mã:
Sub tuoi()
  Dim b, y As Long, k As Long, d As Long
  y = Year(Date)
  For k = 4 To 100
    b = Sheets("sheet1").Range("G" & k).Value
    If b <> Empty And IsDate(b) Then
      d = y - Year(b)
      If DateSerial(y, Month(b), Day(b)) > Date Then d = d - 1
      Sheets("sheet1").Range("H" & k).Value = d
    End If
  Next
End Sub
rất tuyệt vời anh ạ.
i = 1 to 1088 với dữ liệu gián đoạn ở cột G. Vậy mà code nó tính chỉ có 09s:23sec rất tuyệt vời. Xin cảm ơn anh nhiều.
 
Lần chỉnh sửa cuối:
chậm bạn ơi. vì dữ liệu lớn lắm
Thế bạn đã thử code ở bài số #5 chưa?
Bài đã được tự động gộp:

Để tôi dùng thủ thuật tăng tốc cho nó một chút và loại trừ ô trống:

PHP:
Sub TinhTuoi()
    Dim e As Long
    Dim rngDate As Range
    e = Sheets("sheet1").Range("C" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    For Each rngDate In Sheets("sheet1").Range("G4:G" & e)
        If rngDate.Value > "" And IsDate(rngDate.Value) Then
            rngDate.Offset(, 1).Value = Format(Date - rngDate.Value, "yy")
        End If
    Next
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
nó vẫn tính luôn các ô không có dữ liệu.
Do bạn khai báo b là Date, ô trống bị hiểu là 0:00 ngày 1/1/1900
Sửa lại If b > 0 then
Sau khi sửa như thế tôi chạy đến dòng 10.000, với 1200 dòng có số liệu cũng chỉ 0.5 giây, chưa nói đến việc sửa code cho hết lủng củng.
Bài đã được tự động gộp:

Thế bạn đã thử code ở bài số #5 chưa?
Code bài 5 cũng tính luôn cho ô trống
 
Code bài 5 cũng tính luôn cho ô trống
PHP:
Sub TinhTuoi()
    Dim rngDate As Range
    Dim e As Long, r As Long, u As Long
    e = Sheets("sheet1").Range("C" & Rows.Count).End(xlUp).Row
    Dim arrNamSinh
    arrNamSinh = Sheets("sheet1").Range("G4:G" & e).Value
    u = UBound(arrNamSinh)
    For r = 1 To u
        If arrNamSinh(r, 1) > "" And IsDate(arrNamSinh(r, 1)) Then
            arrNamSinh(r, 1) = Format(Date - arrNamSinh(r, 1), "yy")
        Else
            arrNamSinh(r, 1) = ""
        End If
    Next
    Sheets("sheet1").Range("H4").Resize(u).Value = arrNamSinh
End Sub

Vầy là lẹ nhất nè, khỏi duyệt qua range mà duyệt qua mảng là nhanh rồi.
 
Mã:
          arrNamSinh(r, 1) = Format(Date - arrNamSinh(r, 1), "yy")

Vầy là lẹ nhất nè, khỏi duyệt qua range mà duyệt qua mảng là nhanh rồi.
Không nói chuyện lẹ hay không, vì mảng là nhanh đương nhiên, tôi chỉ nói bài 5 tính luôn dòng trống
Ngoài ra nếu ngày sinh là 22/8/2021 (tức là 1 ngày tuổi), code dùng câu lệnh này sẽ tính ra 99 tuổi.
 
Không nói chuyện lẹ hay không, vì mảng là nhanh đương nhiên, tôi chỉ nói bài 5 tính luôn dòng trống
Ngoài ra nếu ngày sinh là 22/8/2021 (tức là 1 ngày tuổi), code dùng câu lệnh này sẽ tính ra 99 tuổi.
Hahaha, nhờ lão chết tiệt mà phát hiện ra phương pháp đó bị lỗi 2 ngày: hôm nay và hôm qua, vậy thì dễ xử lý rồi!
PHP:
Sub TinhTuoi()
    Dim arrNamSinh
    Dim rngDate As Range
    Dim dteLimit As Date
    Dim e As Long, r As Long, u As Long
    dteLimit = Date - 2
    e = Sheets("sheet1").Range("C" & Rows.Count).End(xlUp).Row
    arrNamSinh = Sheets("sheet1").Range("G4:G" & e).Value
    u = UBound(arrNamSinh)
    For r = 1 To u
        If arrNamSinh(r, 1) > "" And IsDate(arrNamSinh(r, 1)) Then
            If arrNamSinh(r, 1) > dteLimit Then
                arrNamSinh(r, 1) = 0
            Else
                arrNamSinh(r, 1) = Format(Date - arrNamSinh(r, 1), "yy")
            End If
        Else
            arrNamSinh(r, 1) = ""
        End If
    Next
    Sheets("sheet1").Range("H4").Resize(u).Value = arrNamSinh
End Sub
 
Quá nhiều trường hợp sai như thế là thuật toán sai rồi, vậy thì dùng thuật toán này, đảm bảo chính xác 100%! Và đảm bảo ngắn gọn.
PHP:
Sub TinhTuoi()
    Dim arrNamSinh
    Dim e As Long, r As Long, u As Long
    e = Sheets("sheet1").Range("C" & Rows.Count).End(xlUp).Row
    arrNamSinh = Sheets("sheet1").Range("G4:G" & e).Value
    u = UBound(arrNamSinh)
    For r = 1 To u
        If arrNamSinh(r, 1) > "" And IsDate(arrNamSinh(r, 1)) Then
            arrNamSinh(r, 1) = DateDiff("yyyy", arrNamSinh(r, 1), Date)
        Else
            arrNamSinh(r, 1) = ""
        End If
    Next
    Sheets("sheet1").Range("H4").Resize(u).Value = arrNamSinh
End Sub
 
Nếu tính tuổi để làm chế độ hưu trí thì phải tính chính xác đến tháng & làm tròn 6 tháng (nữa năm)
Tính tuổi để coi bói thì phải tính đến can chi;
Nếu tính tuổi để xin chính quyền cấp hôn thú thì phải tròn năm tuổi (hình như các bạn đang đi sâu vô cách tính này)
Tính tuổi tròn còn dùng vào việc thi hành nghĩa vu QS, tuổi lao động công ích, Tuổi đi xe buýt thành phố miễn phí,. . . .

Mình vẫn chưa rõ là tác gia bài đăng cần tính tuổi chính xác là cỡ chính xác nào.

Chúc mọi ngườii vui & khỏe nha!
Chào!
 
Mình vẫn chưa rõ là tác gia bài đăng cần tính tuổi chính xác là cỡ chính xác nào.
Code tác giả khen đúng ở bài 1 cho kết quả 0 tuổi nếu sinh ngày 23/8/2020 (364 ngày tuổi), thì đó là mức độ chính xác mong muốn của chàng.
 
Thế thì quá đơn giản - năm trừ năm, còn ngày và tháng không là cái đinh gì cả. Nghĩa là sinh 31.12.2020 thì vào ngày today = 01.01.2021 là 1 tuổi. :D
Ha ha, em đọc qua thì thấy tính tuổi bỏ dòng trống gì đó, hay có đoạn đếm ngày mà em không coi.
 
Nói thêm trong trường hợp tính tuổi hưu trí:
Người ta tính chẵn theo tháng, ví dụ sinh ngày 13 tháng 8 năm 60, thì đến ngày 1/06/2020 người ta cho về nghỉ trước 3 tháng chờ sổ hưu;
Nhưng khi tính lương hưu thì người ta căn cứ vào lần lên /xuống lương trung bình của 60 tháng cuối đời công tác;
Nhưng trong quá trình công tác của đương sự thì người ta làm tròn đến 15 ngày của tháng; Ví dụ Ô. GPE làm trưởng bộ phận từ 1/7/2006 đến 17/7/2007 thì ông này được tính là trưởng bộ phận 11 tháng;
Nhưng ngày 13/7/2007 có quyết định lương khác cho ông này, thì chức trưởng bộ phận của ông này chỉ là 12 tháng.

Chúc các bạn vui & khỏe!
 

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

Back
Top Bottom