VBA Tự tính tuổi dựa vào ngày sinh (1 người xem)

[mrtq_86]

Mình làm code tự tính tuổi dựa trên ngày sinh như sau:
Có cách nào làm hợp lý hơn không mong chỉ giúp.

Sub calculateage()    Dim birthday() As Variant
    birthday = Range("A4:A" & Range("A4").End(xlDown).Row).Value
    
    For i = 1 To UBound(birthday)


         Range("B4").Resize(UBound(birthday)).Value = "=Int(($C$3 - A4) / 365.25)"
    Next i
    
End Sub

 

[VetMini]

Hợp lý tức là cách tính hợp lý hay là code hợp lý?
Trước mắt thì cả 2 đều không bình thường. Nhưng biết đâu bạn cố tình tính theo kiểu không bình thường.

 

[ndu96081631]

Mình làm code tự tính tuổi dựa trên ngày sinh như sau:
Có cách nào làm hợp lý hơn không mong chỉ giúp.
View attachment 171603

Sub calculateage()    Dim birthday() As Variant
    birthday = Range("A4:A" & Range("A4").End(xlDown).Row).Value
    
    For i = 1 To UBound(birthday)


         Range("B4").Resize(UBound(birthday)).Value = "=Int(($C$3 - A4) / 365.25)"
    Next i
    
End Sub

Excel có hàm DATEDIF chuyên làm vụ này sao bạn không dùng mà tính gì kỳ cục vậy?

 

[mrtq_86]

Hợp lý tức là cách tính hợp lý hay là code hợp lý?
Trước mắt thì cả 2 đều không bình thường. Nhưng biết đâu bạn cố tình tính theo kiểu không bình thường.

Mình muốn viết hàm tự tính tuổi, không phải kéo công thức để người khác không biết sử dụng excel làm việc. Bạn có thể giúp mình sửa lại code được không.

Thanks!

 

[mrtq_86]

Mình bỏ vòng lặp chạy tốt rồi.

 

[HieuCD]

Mình làm code tự tính tuổi dựa trên ngày sinh như sau:
Có cách nào làm hợp lý hơn không mong chỉ giúp.
View attachment 171603

Sub calculateage()    Dim birthday() As Variant
    birthday = Range("A4:A" & Range("A4").End(xlDown).Row).Value
    
    For i = 1 To UBound(birthday)


         Range("B4").Resize(UBound(birthday)).Value = "=Int(($C$3 - A4) / 365.25)"
    Next i
    
End Sub

chỉnh lại cho chuẩn

Sub calculateage()
  Dim R As Long
  R = Range("A65500").End(xlUp).Row - 4 + 1
  If R > 3 Then Range("B4").Resize(R).Value = "=INT(YEARFRAC(A4,$C$3))"
End Sub

 

[mrtq_86]

chỉnh lại cho chuẩn

Sub calculateage()
  Dim R As Long
  R = Range("A65500").End(xlUp).Row - 4 + 1
  If R > 3 Then Range("B4").Resize(R).Value = "=INT(YEARFRAC(A4,$C$3))"
End Sub

Hi HieuCD,

Code bạn khi click, click... sẽ đẩy thêm dòng cuối.

 

[HieuCD]

Hi HieuCD,

Code bạn khi click, click... sẽ đẩy thêm dòng cuối.

không rỏ ý của bạn, file mẩu chạy bình thường

 

[mrtq_86]

không rỏ ý của bạn, file mẩu chạy bình thường

Hi HieuCD,

- Mình gửi bạn file bạn kiểm tra giùm (SHEET DSNU), trong đó có 3 funtion tính tuổi (Mình muốn tính tuổi danh sách đã điền thông tin họ tên, ngày sinh....
- Nếu dòng ô ngày sinh trống thì bỏ qua và để trống không có công thức, người cuối cùng thì kết thúc vòng lặp)
Trong đó:
- CALCULATE 3 của bạn khi gọi function đó liên tục thì tự add thêm vào dòng cuối.
- CALCULATE 2 thì đến dòng trống bị dừng lại.
- CALCULATE 1 mình đang làm để loại bỏ ngày sinh trống nhưng chưa được


Thanks!

 

[HieuCD]

Hi HieuCD,
- Mình gửi bạn file bạn kiểm tra giùm (SHEET DSNU), trong đó có 3 funtion tính tuổi (Mình muốn tính tuổi danh sách đã điền thông tin họ tên, ngày sinh....
- Nếu dòng ô ngày sinh trống thì bỏ qua và để trống không có công thức, người cuối cùng thì kết thúc vòng lặp)
Trong đó:
- CALCULATE 3 của bạn khi gọi function đó liên tục thì tự add thêm vào dòng cuối.
- CALCULATE 2 thì đến dòng trống bị dừng lại.
- CALCULATE 1 mình đang làm để loại bỏ ngày sinh trống nhưng chưa được
Thanks!

Không phải tự nhiên code trước mình ghi là -4+1, số 4 là thứ tự dòng đầu
bạn dùng code

Sub calculateage3()
  Dim R As Long
  With Sheets("DSNU")
    R = .Range("F65500").End(xlUp).Row - 6 + 1
    If R < 1 Then Exit Sub
     .Range("D6").Resize(R).Value = "=IF(F6="""","""",INT(YEARFRAC(F6,$A$2)))"
  End With
End Sub

 

[mrtq_86]

OK, Cảm ơn bạn rất nhiều.

Mình hỏi thêm, trong trường hợp này muốn đưa ra kết quả thôi mà không hiện công thức lên cells thì làm như thế nào.

 

[mrtq_86]

OK, Cảm ơn bạn rất nhiều.

Mình muốn hỏi thêm: Không đưa ra cells công thức mà chỉ có dữ liệu thôi thì phải làm như thế nào?

Thanks!

 

[HieuCD]

OK, Cảm ơn bạn rất nhiều.

Mình muốn hỏi thêm: Không đưa ra cells công thức mà chỉ có dữ liệu thôi thì phải làm như thế nào?

Thanks!

thêm một dòng lệnh hơi ngộ một chút

Sub calculateage3()
  Dim R As Long
  With Sheets("DSNU")
    R = .Range("F65500").End(xlUp).Row - 6 + 1
    If R < 1 Then Exit Sub
    .Range("D6").Resize(R).Value = "=IF(F6="""","""",INT(YEARFRAC(F6,$A$2)))"
[COLOR=#ff0000]    .Range("D6").Resize(R).Value = .Range("D6").Resize(R).Value[/COLOR]
  End With
End Sub

 

[mrtq_86]

thêm một dòng lệnh hơi ngộ một chút

Sub calculateage3()
  Dim R As Long
  With Sheets("DSNU")
    R = .Range("F65500").End(xlUp).Row - 6 + 1
    If R < 1 Then Exit Sub
    .Range("D6").Resize(R).Value = "=IF(F6="""","""",INT(YEARFRAC(F6,$A$2)))"
[COLOR=#ff0000]    .Range("D6").Resize(R).Value = .Range("D6").Resize(R).Value[/COLOR]
  End With
End Sub

Oh, hay nhể

Thank you!