Xin VBA tính kết quả theo điều kiện

[tranthuy28190]

Em chào các bác!

Hiện tại em đã viết hàm điều kiện cho file excel này. Tuy nhiên hàm khá dài và các option không được liệt kê đầy đủ nên rất mong có bác cao nhân nào viết code VBA giúp em với ạ.
Em gửi file excel ạ. Trong đó có 2 sheet (1 sheet là em đã để sẵn hàm excel cột R nhưng chưa viết đầy đủ, 1 sheet là Quy luật mong muốn)

Nhờ các bác giúp em với ạ.
Em cảm ơn nhiều!

 

[cantl]

Em chào các bác!

Hiện tại em đã viết hàm điều kiện cho file excel này. Tuy nhiên hàm khá dài và các option không được liệt kê đầy đủ nên rất mong có bác cao nhân nào viết code VBA giúp em với ạ.
Em gửi file excel ạ. Trong đó có 2 sheet (1 sheet là em đã để sẵn hàm excel cột R nhưng chưa viết đầy đủ, 1 sheet là Quy luật mong muốn)

Nhờ các bác giúp em với ạ.
Em cảm ơn nhiều!

Pass 123 không mở được.

 

[bebo021999]

Bạn dùng hàm UDF nhé

Tại ô R4

=getdate(I4,K4)

Với I4 là Maker, K4 là code
copy xuống.

code như sau:
(Alt-F11 mở VBA, insert/module, copy paste code )

Option Explicit
Function GetDate(Maker As String, code As String)
Dim y, m, d, c1
c1 = UCase(code)
Select Case UCase(Maker)
    Case "ROHM", "TAIYOYUDEN"
        GetDate = Range("O1").Value
        Exit Function
    Case "ASAHIRUBBE", "SOGO"
        GetDate = Cells(Application.Caller.Row, "K").Value
        Exit Function
    Case "HOKURIKU"
        y = "202" & Mid(c1, 2, 1): m = Mid(c1, 3, 2): d = Mid(c1, 5, 2)
    Case "SANKEN"
        y = "202" & Mid(c1, 1, 1): m = Mid(c1, 2, 1): d = Mid(c1, 3, 2)
    Case "TOSHIBA"
        y = "201" & Mid(c1, 1, 1): m = Mid(c1, 2, 1): d = Mid(c1, 3, 2)
    Case "STANLEY"
        y = "202" & Mid(c1, 2, 1): m = Mid(c1, 3, 2): d = Mid(c1, 5, 2)
    Case "TDK"
        y = "202" & Mid(c1, 2, 1): m = InStr(1, "ABCDEFGHIJKL", Mid(c1, 3, 1)): d = Mid(c1, 4, 2)
    Case "YAMAMOTO"
        y = "202" & Mid(c1, 2, 1): m = InStr(1, "123456789XYZ", Mid(c1, 3, 1)): d = (InStr(1, "ABCD", Mid(c1, 4, 1)) - 1) * 10 + Mid(c1, 5, 1)
End Select
GetDate = DateSerial(y, m, d)
End Function

 

[tranthuy28190]

Pass 123 không mở được.

Hic, sorry bác. Pass là Stxv@2022 ạ. Em xin lỗi vì cứ nghĩ mở pass rồi

Bài đã được tự động gộp: 29/11/22

Bạn dùng hàm UDF nhé

Tại ô R4

=getdate(I4,K4)

Với I4 là Maker, K4 là code
copy xuống.

code như sau:
(Alt-F11 mở VBA, insert/module, copy paste code )

Option Explicit
Function GetDate(Maker As String, code As String)
Dim y, m, d, c1
c1 = UCase(code)
Select Case UCase(Maker)
    Case "ROHM", "TAIYOYUDEN"
        GetDate = Range("O1").Value
        Exit Function
    Case "ASAHIRUBBE", "SOGO"
        GetDate = Cells(Application.Caller.Row, "K").Value
        Exit Function
    Case "HOKURIKU"
        y = "202" & Mid(c1, 2, 1): m = Mid(c1, 3, 2): d = Mid(c1, 5, 2)
    Case "SANKEN"
        y = "202" & Mid(c1, 1, 1): m = Mid(c1, 2, 1): d = Mid(c1, 3, 2)
    Case "TOSHIBA"
        y = "201" & Mid(c1, 1, 1): m = Mid(c1, 2, 1): d = Mid(c1, 3, 2)
    Case "STANLEY"
        y = "202" & Mid(c1, 2, 1): m = Mid(c1, 3, 2): d = Mid(c1, 5, 2)
    Case "TDK"
        y = "202" & Mid(c1, 2, 1): m = InStr(1, "ABCDEFGHIJKL", Mid(c1, 3, 1)): d = Mid(c1, 4, 2)
    Case "YAMAMOTO"
        y = "202" & Mid(c1, 2, 1): m = InStr(1, "123456789XYZ", Mid(c1, 3, 1)): d = (InStr(1, "ABCD", Mid(c1, 4, 1)) - 1) * 10 + Mid(c1, 5, 1)
End Select
GetDate = DateSerial(y, m, d)
End Function

Em cảm ơn bác nhiều ạ <3 <3