H
Hồng Phương
Guest
Em nhờ anh chị viết giúp hàm như trong hình ảnh
Em cảm ơn các anh chị!
Em cảm ơn các anh chị!
Bạn cần đăng nhập để thấy đính kèm
'Input: Dien dan tu hoc vb;a
'Output:
Function tachkytuc(ByVal s As String) As String
Dim i As Integer
Dim n As Integer
Dim tem As String
Dim kq As String 'Ket qua
Const hs1 As String = "; "
n = Len(s) 'Chieu dai chuoi ky tu s
kq = ""
If n = 0 Then Exit Function 'thoat khoi ham
For i = 1 To n Step 1
tem = Mid(s, i, 1) 'lay mot ky tu o vi tri i chieu dai la 1 trong s
If InStr(1, hs1, tem) > 0 Then
'Nếu ký tự là ; hoặc khoảng trống " " thì không lấy
Else
kq = kq & "," & tem 'Ket qua: ,D,i,e,n,d,a,n,t,u,h,o,c,v,b,a
End If
Next i
tachkytuc = Right(kq, Len(kq) - 1)
End Function
Function main_tachkytu(ByVal s1 As String, ByVal s2 As String, ByVal s3 As String) As String
main_tachkytu = tachkytuc(s1) & "," & tachkytuc(s2) & tachkytuc(s3)
End Function
'Input: Dien dan tu hoc vb;a
'Output:
Function tachkytuc(ByVal s As String) As String
Dim i As Integer
Dim n As Integer
Dim tem As String
Dim kq As String 'Ket qua
Const hs1 As String = "; "
n = Len(s) 'Chieu dai chuoi ky tu s
kq = ""
If n = 0 Then Exit Function 'thoat khoi ham
For i = 1 To n Step 1
tem = Mid(s, i, 1) 'lay mot ky tu o vi tri i chieu dai la 1 trong s
If InStr(1, hs1, tem) > 0 Then
Else
kq = kq & "," & tem 'Ket qua: ,D,i,e,n,d,a,n,t,u,h,o,c,v,b,a
End If
Next i
tachkytuc = Right(kq, Len(kq) - 1)
End Function
Function main_tachkytu(ByVal s1 As String, ByVal s2 As String, ByVal s3 As String) As String
main_tachkytu = tachkytuc(s1) & "," & tachkytuc(s2) & tachkytuc(s3)
End Function
'Input: Dien dan tu hoc vb;a
'Output: D,i,e,n,d,a,n,t,u,h,o,c,v,b,a
Function tachkytu(ByVal s As String) As String
Dim i As Integer
Dim n As Integer
Dim tem As String
Dim kq As String 'Ket qua
Const hs1 As String = "; "
n = Len(s) 'Chieu dai chuoi ky tu s
kq = ""
If n = 0 Then Exit Function 'thoat khoi ham
For i = 1 To n Step 1
tem = Mid(s, i, 1) 'lay mot ky tu o vi tri i chieu dai la 1 trong s
If InStr(1, hs1, tem) > 0 Then
Else
kq = kq & "," & tem 'Ket qua: ,D,i,e,n,d,a,n,t,u,h,o,c,v,b,a
End If
Next i
tachkytu = Right(kq, Len(kq) - 1)
End Function
Function submain_tachkytu(ByVal r As Range) As String
Dim arr As Variant
Dim i As Integer
Dim j As Integer
Dim kq As String
On Error Resume Next
arr = r.Value
For i = LBound(arr, 1) To UBound(arr, 1) Step 1
For j = LBound(arr, 2) To UBound(arr, 2) Step 1
kq = kq & "," & tachkytu(CStr(arr(i, j)))
Next j
Next i
submain_tachkytu = Right(kq, Len(kq) - 1)
End Function
Function tach(ParamArray mang())
Dim T, T1, s As String, i As Integer
For Each T In mang
For Each T1 In T
If T1 <> Empty Then
T1 = Replace(T1, ";", "")
T1 = Replace(T1, " ", "")
For i = 1 To Len(T1)
s = s & "," & Mid(T1, i, 1)
Next i
End If
Next
Next
tach = Right(s, Len(s) - 1)
End Function