Dự án hỗ trợ thành viên số 03

Trạng thái
Không mở trả lời sau này.

giaiphapvba

Administrator
Thành viên BQT
-Dự án hỗ trợ số 01 .
-Dự án này được thực hiện theo yêu cầu của thành viên, có cam kết hỗ trợ diễn đàn tài chính sau khi dự án kết thúc. Thành viên không cần quan tâm topic này để khỏi mất thời gian.
Topic này nhằm trao đổi hoặc ghi chú các đoạn code nhỏ.

Bài toán 1:
4/20*54K Ngày 20 tháng 4 (năm hiện tại) giao 54000. Lịch giao hàng phù hợp.
4/20*54000 Ngày 20 tháng 4 (năm hiện tại) giao 54000. Lịch giao hàng phù hợp.
4/20/2020*54K Ngày 20 tháng 4 năm 2020 giao 54000. Lịch giao hàng phù hợp.
4/20/2020*54000 Ngày 20 tháng 4 năm 2020 giao 54000. Lịch giao hàng phù hợp.
TBC*7840000 Lịch giao hàng không phù hợp
Mã:
Sub test()
    Dim s As String
    Dim n   As Integer
    n = 2020
    
    'Truong hop 1: 4/20*54K  Gia tri ky vong  4/20/2020tuhocvba.net54000
    's = "4/20*54K"
    s = ThisWorkbook.Sheets(1).Cells(1, 1)
    Debug.Print giaohang(s, n)
    'Truong hop 2: 4/20*54000 Gia tri ky vong 4/20/2020tuhocvba.net54000
    s = ThisWorkbook.Sheets(1).Cells(2, 1)
    Debug.Print giaohang(s, n)
    'Truong hop 3: 4/20/2020*54K Gia tri ky vong 4/20/2020tuhocvba.net54000
    s = ThisWorkbook.Sheets(1).Cells(3, 1)
    Debug.Print giaohang(s, n)
    'Truong hop 4: '4/20/2020*54000 Gia tri ky vong 4/20/2020tuhocvba.net54000
    s = ThisWorkbook.Sheets(1).Cells(4, 1)
    Debug.Print giaohang(s, n)
    'Truong hop 5: 'TBC*7840000 Gia tri ky vong TBC
    s = ThisWorkbook.Sheets(1).Cells(5, 1)
    Debug.Print giaohang(s, n)
     'Truong hop 6: 4/20/2020*54000  Gia tri ky vong  TBC
    's = "4/20/2020*54000"
    s = ThisWorkbook.Sheets(1).Cells(4, 1)
    Debug.Print giaohang(s, 2021)
End Sub

Function giaohang(ByVal s As String, ByVal nam As Integer) As String
    Dim arr
    Dim temp    As String, temp2 As String
    Dim d       As Date
    Dim n       As Integer
    
    arr = Split(s, "*")
    If (UBound(arr) - LBound(arr) + 1) <> 2 Then
        GoTo thoat
    End If
    'Xet arr(0)
    temp = CStr(arr(0))
    temp2 = Replace(temp, "/", "")
    
    If Len(temp) = Len(temp2) Then
        GoTo thoat
    ElseIf (Len(temp) - Len(temp2)) = 1 Then
        'Truong hop 1: 4/20
        d = CDate(Format(temp & "/" & CStr(nam), "mm/dd/yyyy"))
    ElseIf (Len(temp) - Len(temp2)) = 2 Then
        'Truong hop 1: 4/20/2020
        d = CDate(Format(temp, "mm/dd/yyyy"))
    End If
  
    If (Year(d) - nam) <> 0 Then GoTo thoat 'Ex: 2020 <> 2021
    
    'Xet arr(1)
    temp = CStr(arr(1))
    If temp = "" Then
        temp = "0"
    ElseIf UCase(Right(temp, 1)) = "K" Then
        temp2 = Left(temp, Len(temp) - 1)
        If IsNumeric(temp) Then
        
        ElseIf IsNumeric(temp2) = True Then
            temp = temp2 & "000"
        Else
            GoTo thoat
        End If
    End If
    giaohang = CStr(d) & "tuhocvba.net" & temp
    Exit Function
    
thoat:
        giaohang = "TBC" 'Khong phu hop
End Function
Bạn cần đăng nhập để thấy hình ảnh

Kết quả:
Mã:
2020/04/20tuhocvba.net54000
2020/04/20tuhocvba.net54000
2020/04/20tuhocvba.net54000
2020/04/20tuhocvba.net54000
TBC
TBC
Đúng như kỳ vọng. OK.
 

tuhocvba

Administrator
Thành viên BQT
Input người dùng nhập khác với định dạng trên thì lỗi:
Input: 4/-/2020*50000
Nên thêm code:
Mã:
Function giaohang(ByVal s As String, ByVal nam As Integer) As String
    Dim arr
    Dim temp    As String, temp2 As String
    Dim d       As Date
    Dim n       As Integer
    
    On Error GoTo thoat
    arr = Split(s, "*")
    If (UBound(arr) - LBound(arr) + 1) <> 2 Then
        GoTo thoat
    End If
    'Xet arr(0)
    temp = CStr(arr(0))
    temp2 = Replace(temp, "/", "")
    
    If Len(temp) = Len(temp2) Then
        GoTo thoat
    ElseIf (Len(temp) - Len(temp2)) = 1 Then
        'Truong hop 1: 4/20
        d = CDate(Format(temp & "/" & CStr(nam), "mm/dd/yyyy"))
    ElseIf (Len(temp) - Len(temp2)) = 2 Then
        'Truong hop 1: 4/20/2020
        d = CDate(Format(temp, "mm/dd/yyyy"))
    End If
 
    If (Year(d) - nam) <> 0 Then GoTo thoat 'Ex: 2020 <> 2021
    
    'Xet arr(1)
    temp = CStr(arr(1))
    If temp = "" Then
        temp = "0"
    ElseIf UCase(Right(temp, 1)) = "K" Then
        temp2 = Left(temp, Len(temp) - 1)
        If IsNumeric(temp) Then
        
        ElseIf IsNumeric(temp2) = True Then
            temp = temp2 & "000"
        Else
            GoTo thoat
        End If
    End If
    giaohang = CStr(d) & "tuhocvba.net" & temp
    Exit Function
    
thoat:
        giaohang = "TBC" 'Khong phu hop
End Function
 
Trạng thái
Không mở trả lời sau này.
Top