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.

hoahongden142917 · 23/8/21

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

ptm0412 · 23/8/21

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á!

Hoàng Trọng Nghĩa · 23/8/21

hoahongden142917 đã viết:
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")

HieuCD · 23/8/21

hoahongden142917 đã viết:
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

Hoàng Trọng Nghĩa · 23/8/21

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ả!

hoahongden142917 · 23/8/21

ptm0412 đã viết:
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: 23/8/21

Hoàng Trọng Nghĩa đã viết:
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: 23/8/21

HieuCD đã viết:

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: 23/8/21

ptm0412 đã viết:
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: 23/8/21

HieuCD đã viết:

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.

Hoàng Trọng Nghĩa · 23/8/21

hoahongden142917 đã viết:
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: 23/8/21

Để 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

ptm0412 · 23/8/21

hoahongden142917 đã viết:
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: 23/8/21

Hoàng Trọng Nghĩa đã viết:
Thế bạn đã thử code ở bài số #5 chưa?

Code bài 5 cũng tính luôn cho ô trống

Hoàng Trọng Nghĩa · 23/8/21

ptm0412 đã viết:
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.

ptm0412 · 23/8/21

Hoàng Trọng Nghĩa đã viết:
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.

SA_DQ · 23/8/21

Tuổi = ([Ngày hiện tại] - [Ngày Sinh]) / 365.25

Maika8008 · 23/8/21

SA_DQ đã viết:
Tuổi = ([Ngày hiện tại] - [Ngày Sinh]) / 365.25

Tuổi ta (tuổi mụ) = RoundDown(([Ngày hiện tại] - [Ngày Sinh]) / 365.25, 0) + 2 --=0

Hoàng Trọng Nghĩa · 23/8/21

ptm0412 đã viết:
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

befaint · 24/8/21

Hoàng Trọng Nghĩa đã viết:
Format(Date - arrNamSinh(r, 1), "yy")

Chỗ này anh dùng hàm Format làm gì đấy anh?

Anh thử với trường hợp Date - arrNamSinh(r, 1) trả về số < 10 và >= 100 xem nào.

ptm0412 · 24/8/21

befaint đã viết:
Anh thử với trường hợp Date - arrNamSinh(r, 1) trả về số < 10 và >= 100 xem nào.

Thử luôn và kết quả:

Hoàng Trọng Nghĩa · 24/8/21

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

SA_DQ · 24/8/21

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!

ptm0412 · 24/8/21

SA_DQ đã viết:
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.

tranhungdao12a3 · 24/8/21

Tuổi:=YEAR(today())-YEAR('Table1'[năm sinh])

batman1 · 24/8/21

tranhungdao12a3 đã viết:
Tuổi:=YEAR(today())-YEAR('Table1'[năm sinh])

Thế thì quá đơn giản - năm trừ năm, còn ngày và tháng không là cái đinh gì cả. Nghĩa là sinh 31.12.2020 thì vào ngày today = 01.01.2021 là 1 tuổi.

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.

Thành viên hoạt động

File đính kèm

Bad Excel Member

Chuyên gia GPE

Chuyên gia GPE

Chuyên gia GPE

Thành viên hoạt động

Chuyên gia GPE

Bad Excel Member

Chuyên gia GPE

Bad Excel Member

/(hông là gì!

Thành viên gạo cội

Chuyên gia GPE

|||||||||||||

Bad Excel Member

Chuyên gia GPE

/(hông là gì!

Bad Excel Member

Thành viên tiêu biểu

Thành viên gạo cội

Đếm ngược thời gian