Hàm xóa số trong chuỗi theo điều kiện

snow25

Thành viên tích cực
Tham gia ngày
24 Tháng bảy 2018
Bài viết
1,498
Được thích
1,193
Điểm
210
Em nhờ anh chị và các bác viết giúp hàm như file đính kèm
Em xin cảm ơn ạ!
Em dùng thử cái này.
Mã:
Function layso(ByVal chuoi As String, ByVal mang As Range) As String
         Dim T, s As String, s1 As String, a As Long, dk As Range, i As Long
         s = Left(chuoi, 3)
         s1 = Right(chuoi, Len(chuoi) - 3)
         T = Split(";" & s1, ";")
         For i = 1 To UBound(T)
           If Len(T(i)) > 0 Then
            If Len(T(i)) = 2 Then
            a = CLng(Right(CLng(Right(T(i), 1)) + CLng(Left(T(i), 1)), 1))
            For Each dk In mang
            If Len(dk.Value) > 0 Then
             If a = dk.Value Then
                 T(i) = Empty
             End If
            End If
           Next
           Else
             T(i) = Empty
           End If
         End If
        Next
         For i = 1 To UBound(T)
             If Len(T(i)) > 0 Then
                s = s & T(i) & ";"
             End If
         Next i
         layso = Left(s, Len(s) - 1)
End Function
Mã:
=layso(C4,B6:B10)
 

hongphuong1997

Thành viên tích cực
Tham gia ngày
12 Tháng mười một 2017
Bài viết
400
Được thích
98
Điểm
195
Tuổi
22
Em dùng thử cái này.
Mã:
Function layso(ByVal chuoi As String, ByVal mang As Range) As String
         Dim T, s As String, s1 As String, a As Long, dk As Range, i As Long
         s = Left(chuoi, 3)
         s1 = Right(chuoi, Len(chuoi) - 3)
         T = Split(";" & s1, ";")
         For i = 1 To UBound(T)
           If Len(T(i)) > 0 Then
            If Len(T(i)) = 2 Then
            a = CLng(Right(CLng(Right(T(i), 1)) + CLng(Left(T(i), 1)), 1))
            For Each dk In mang
            If Len(dk.Value) > 0 Then
             If a = dk.Value Then
                 T(i) = Empty
             End If
            End If
           Next
           Else
             T(i) = Empty
           End If
         End If
        Next
         For i = 1 To UBound(T)
             If Len(T(i)) > 0 Then
                s = s & T(i) & ";"
             End If
         Next i
         layso = Left(s, Len(s) - 1)
End Function
Mã:
=layso(C4,B6:B10)
Em cảm ơn anh @snow25 anh ơi anh giúp em cho thêm điều kiện B6:B10 là rời rạc từng ô với anh nhé
 

CHAOQUAY

Thành viên thường trực
Tham gia ngày
24 Tháng tám 2018
Bài viết
393
Được thích
305
Điểm
60
Em nhờ anh chị và các bác viết giúp hàm như file đính kèm
Em xin cảm ơn ạ!
Thêm 1 cách tham khảo
Cú pháp : loc(c4,b6:b7)
Mã:
Function Loc(Chuoi As String, Dk_)
Dim Dk(9)
Dim i, j, k, x, z, t
z = Len(Chuoi)
For Each i In Dk_
    Dk(i) = 1
Next i
For i = 4 To z Step 3
    j = CLng(Mid(Chuoi, i, 1))
    x = CLng(Mid(Chuoi, i + 1, 1))
    k = (x + j) Mod 10
    If Dk(k) = "" Then t = t & " " & j & x
Next i
Loc = Left(Chuoi, InStr(Chuoi, ":")) & Replace(Trim(t), " ", ";")
End Function
 
Top