Tính ngày ngày chế độ Bảo hiểm (BH). (1 người xem)

[tienduyet]

Trước tiên, xin mời Anh/Chị download file đính kèm về thì đọc câu hỏi của em sẽ dễ hiểu hơn.
1. Tại cột E: Thể hiện số ngày nghỉ chế độ BH sau khi đã loại bỏ ngày Chủ nhật.
VD: ID 16047 nghỉ BH từ 17/5/2014 đến hết 23/5/2014 (nghỉ 07 ngày), trong đó có ngày 18/5/2014 là ngày Chủ Nhật.
Vậy, Cho em xin công thức tính toán thế nào ra được: 06 ngày.
Lưu ý: Loại trừ công thức “23/5/2014 – 17/5/2014”, kết quả của công thức này cũng ra 06 ngày nhưng nó sẽ sai đối với những người nghỉ 01 ngày, VD nghỉ từ 23/5/2014 đến hết 23/5/2014, nó sẽ = 0.
2. Tại cột F:
Thật đơn giản nếu ID chỉ xuất hiện 01 lần, ta sẽ áp dụng công thức: =DAY(C2)&"/"&MONTH(C2)&" -> "&DAY(D2)&"/"&MONTH(D2)
Nhưng sẽ rất khó khăn khi ID xuất hiện nhiều hơn 01 lần (nghỉ nhiều ngày chế độ BH nhưng ngắt quãng).
Tức là, tại Ô F9 (ID 15655) công thức em xin ở ô xuất hiện ID lần thứ nhất ra kết quả là: 12/6 -> 12/6, 6/6 -> 6/6, 18/6 -> 18/6 (ko quan trọng thứ tự xuất hiện ngày nghỉ)
Các ô chứa ID xuất hiện tiếp theo sẽ là một khoảng trắng.

Em cảm ơn Anh/Chị rất nhiều!

 

[tienduyet]

137 lượt views rồi mà chưa có anh/chị nào hỗ trợ em vậy ah?

 

[comet_1701]

137 lượt views rồi mà chưa có anh/chị nào hỗ trợ em vậy ah?

Trợ giúp bạn ý một nhé, còn ý hai nghĩ chưa ra

=D2-C2-INT((D2-C2-WEEKDAY(D2-6,2)+8)/7)+1

 

[Hau151978]

137 lượt views rồi mà chưa có anh/chị nào hỗ trợ em vậy ah?

Bạn save as dạng xlsm, thêm đoạn lệnh vào module

Sub a()
Dim i As Integer
Dim n As Integer
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
n = Range("a2").End(xlDown).Row
For i = 2 To n
If Not dic.Exists(Cells(i, 1).Text) Then
dic.Add Cells(i, 1).Text, i
Cells(i, 6) = Format(Cells(i, 3), "dd/mm") & "->" & Format(Cells(i, 4), "dd/mm")
Else
Cells(dic.Item(Cells(i, 1).Text), 6) = Cells(dic.Item(Cells(i, 1).Text), 6) & ", " & Format(Cells(i, 3), "dd/mm") & "->" & Format(Cells(i, 4), "dd/mm")
End If
Next
Set dic = Nothing
End Sub

Chạy thủ tục a()

 

[tienduyet]

Cảm ơn hai anh rất nhiều. Tối về em thử và báo cáo kết quả ngay ah.

Thanks!

 

[tienduyet]

Trợ giúp bạn ý một nhé, còn ý hai nghĩ chưa ra

=D2-C2-INT((D2-C2-WEEKDAY(D2-6,2)+8)/7)+1

Ok rồi ah, hàm đơn giản thế mà em ko nghĩ ra.

Cảm ơn anh!

 

[tienduyet]

Bạn save as dạng xlsm, thêm đoạn lệnh vào module

Sub a()
Dim i As Integer
Dim n As Integer
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
n = Range("a2").End(xlDown).Row
For i = 2 To n
If Not dic.Exists(Cells(i, 1).Text) Then
dic.Add Cells(i, 1).Text, i
Cells(i, 6) = Format(Cells(i, 3), "dd/mm") & "->" & Format(Cells(i, 4), "dd/mm")
Else
Cells(dic.Item(Cells(i, 1).Text), 6) = Cells(dic.Item(Cells(i, 1).Text), 6) & ", " & Format(Cells(i, 3), "dd/mm") & "->" & Format(Cells(i, 4), "dd/mm")
End If
Next
Set dic = Nothing
End Sub

Chạy thủ tục a()

Cảm ơn anh, có lẽ em phải học hỏi thêm VBA thôi ah.

Công dụng của đoạn code anh gửi thật hữu ích.

Thanks!

 

[ndu96081631]

2. Tại cột F:
Thật đơn giản nếu ID chỉ xuất hiện 01 lần, ta sẽ áp dụng công thức: =DAY(C2)&"/"&MONTH(C2)&" -> "&DAY(D2)&"/"&MONTH(D2)
Nhưng sẽ rất khó khăn khi ID xuất hiện nhiều hơn 01 lần (nghỉ nhiều ngày chế độ BH nhưng ngắt quãng).
Tức là, tại Ô F9 (ID 15655) công thức em xin ở ô xuất hiện ID lần thứ nhất ra kết quả là: 12/6 -> 12/6, 6/6 -> 6/6, 18/6 -> 18/6 (ko quan trọng thứ tự xuất hiện ngày nghỉ)
Các ô chứa ID xuất hiện tiếp theo sẽ là một khoảng trắng.

Em cảm ơn Anh/Chị rất nhiều!

Trước đây tôi có viết hàm JoinText và tôi nghĩ nó có thể áp dụng cho bài này được
1> Code:

Function JoinText(ByVal Delimiter As String, ParamArray Arrays()) As String
  Dim aTmp, Arr(), Item, tmp As String
  Dim i As Long, n As Long
  'On Error Resume Next
  For i = LBound(Arrays) To UBound(Arrays)
    aTmp = Arrays(i)
    If Not IsArray(aTmp) Then aTmp = Array(aTmp)
    For Each Item In aTmp
      If TypeName(Item) <> "Error" Then
        tmp = CStr(Item)
        n = n + 1
        ReDim Preserve Arr(1 To n)
        Arr(n) = tmp
      End If
    Next
  Next
  If n Then JoinText = Join(Arr, Delimiter)
End Function

2> Công thức tại F2:

=IF(COUNTIF($B$2:$B2,$B2)=1,JoinText(", ",IF($B$2:$B$17=B2,TEXT($C$2:$C$17,"d/m")&IF($C$2:$C$17=$D$2:$D$17,"","->"&TEXT($D$2:$D$17,"d/m")),1/0)),"")

Gõ xong công thức, bấm tổ hợp phím Ctrl + Shift + Enter rồi kéo fill xuống

 

[comet_1701]

Trước đây tôi có viết hàm JoinText và tôi nghĩ nó có thể áp dụng cho bài này được
1> Code:

Function JoinText(ByVal Delimiter As String, ParamArray Arrays()) As String
  Dim aTmp, Arr(), Item, tmp As String
  Dim i As Long, n As Long
  'On Error Resume Next
  For i = LBound(Arrays) To UBound(Arrays)
    aTmp = Arrays(i)
    If Not IsArray(aTmp) Then aTmp = Array(aTmp)
    For Each Item In aTmp
      If TypeName(Item) <> "Error" Then
        tmp = CStr(Item)
        n = n + 1
        ReDim Preserve Arr(1 To n)
        Arr(n) = tmp
      End If
    Next
  Next
  If n Then JoinText = Join(Arr, Delimiter)
End Function

2> Công thức tại F2:

=IF(COUNTIF($B$2:$B2,$B2)=1,JoinText(", ",IF($B$2:$B$17=B2,TEXT($C$2:$C$17,"d/m")&IF($C$2:$C$17=$D$2:$D$17,"","->"&TEXT($D$2:$D$17,"d/m")),1/0)),"")

Gõ xong công thức, bấm tổ hợp phím Ctrl + Shift + Enter rồi kéo fill xuống

Code của anh nếu biết áp dụng công thức hợp lý, thật lợi hại
Cảm ơn anh nhé

 

[ndu96081631]

Code của anh nếu biết áp dụng công thức hợp lý, thật lợi hại
Cảm ơn anh nhé

Biến lợi hại là ParamArray Arrays() đấy
Bạn triển khai mảng này lợi hại đến đâu thì code sẽ lợi hại đến nấy (giống giống SUMPRODUCT)
Vậy nên phần LỢI HẠI này thuộc về người dùng, không phải do code của tôi
Ẹc... Ẹc...

 

[Hau151978]

Em cũng định dùng công thức mảng bằng hàm concatenate thay cho toán tử & nhưng hàm này không nối chuỗi của cả vùng, concatenate(A2:A10) không nối chuỗi ở A2:A10.

 

[ndu96081631]

Em cũng định dùng công thức mảng bằng hàm concatenate thay cho toán tử & nhưng hàm này không nối chuỗi của cả vùng, concatenate(A2:A10) không nối chuỗi ở A2:A10.

Bạn hãy "yên tâm" rằng trong Excel không có hàm nào đó khả năng nối chuỗi từ mảng hoặc vùng dữ liệu (chứ đừng nói là nối chuỗi theo điều kiện)
Hy vọng Excel 2015 hoặc 2020 sẽ có

 

[nginh]

Trước đây tôi có viết hàm JoinText và tôi nghĩ nó có thể áp dụng cho bài này được
1> Code:

Function JoinText(ByVal Delimiter As String, ParamArray Arrays()) As String
  Dim aTmp, Arr(), Item, tmp As String
  Dim i As Long, n As Long
  'On Error Resume Next
  For i = LBound(Arrays) To UBound(Arrays)
    aTmp = Arrays(i)
    If Not IsArray(aTmp) Then aTmp = Array(aTmp)
    For Each Item In aTmp
      If TypeName(Item) <> "Error" Then
        tmp = CStr(Item)
        n = n + 1
        ReDim Preserve Arr(1 To n)
        Arr(n) = tmp
      End If
    Next
  Next
  If n Then JoinText = Join(Arr, Delimiter)
End Function

2> Công thức tại F2:

=IF(COUNTIF($B$2:$B2,$B2)=1,JoinText(", ",IF($B$2:$B$17=B2,TEXT($C$2:$C$17,"d/m")&IF($C$2:$C$17=$D$2:$D$17,"","->"&TEXT($D$2:$D$17,"d/m")),1/0)),"")

Gõ xong công thức, bấm tổ hợp phím Ctrl + Shift + Enter rồi kéo fill xuống

Hàm này lợi hại nhưng phức tạp quá, như thế này đơn giản hơn

Function JT(ID As Range) As String
If Application.Match(ID, Columns(ID.Column), 0) = ID.Row Then
    Set c = ID
    Do
        If c.Row = ID.Row Then JT = c.Offset(, 2) & "-->" & c.Offset(, 3) _
        Else JT = JT & Chr(10) & c.Offset(, 2) & "-->" & c.Offset(, 3)
        Set c = Columns(ID.Column).Find(c, c)
    Loop Until c Is Nothing Or c.Address = ID.Address
End If
End Function

cú pháp
=JT(ID)

 

[Hau151978]

Hàm này lợi hại nhưng phức tạp quá, như thế này đơn giản hơn

Function JT(ID As Range) As String
If Application.Match(ID, Columns(ID.Column), 0) = ID.Row Then
    Set c = ID
    Do
        If c.Row = ID.Row Then JT = c.Offset(, 2) & "-->" & c.Offset(, 3) _
        Else JT = JT & Chr(10) & c.Offset(, 2) & "-->" & c.Offset(, 3)
        Set c = Columns(ID.Column).Find(c, c)
    Loop Until c Is Nothing Or c.Address = ID.Address
End If
End Function

cú pháp
=JT(ID)

Hàm của bác rất hay!

 

[tienduyet]

Hàm này lợi hại nhưng phức tạp quá, như thế này đơn giản hơn

Function JT(ID As Range) As String
If Application.Match(ID, Columns(ID.Column), 0) = ID.Row Then
    Set c = ID
    Do
        If c.Row = ID.Row Then JT = c.Offset(, 2) & "-->" & c.Offset(, 3) _
        Else JT = JT & Chr(10) & c.Offset(, 2) & "-->" & c.Offset(, 3)
        Set c = Columns(ID.Column).Find(c, c)
    Loop Until c Is Nothing Or c.Address = ID.Address
End If
End Function

cú pháp
=JT(ID)

Khâm phục bác với đoạn code trên. Rất ngắn mà rất hay.