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

[hongphuong1997]

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 ạ!

 

[snow25]

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.

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

=layso(C4,B6:B10)

 

[hongphuong1997]

Em dùng thử cái này.

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

=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]

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)

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