批量隐藏身份证号码和手机号码

Sub 身份证()
    With Me
        .Range("f:f").NumberFormatLocal = "@"
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For x = 2 To lastRow
            '        If x = 43 Then Stop
            s = Trim(.Cells(x, 6).Value)
            If InStr(s, Chr(10)) And Len(s) > 0 Then
                res = ""
                tem = Split(s, Chr(10))
                '                .Cells(x, 5) = Trim(Replace(s, Chr(10), ""))
                For i = 0 To UBound(tem)
                    If Len(tem(i)) > 0 Then
                        res = res & Left(tem(i), 6) & "********" & Right(tem(i), 4) & Chr(10)
                    End If
                Next
                '                res = Left(tem(0), 6) & "****" & Right(tem(0), 4) & Chr(10) & Left(tem(1), 6) & "****" & Right(tem(1), 4) & Chr(10) & Left(tem(2), 6) & "****" & Right(tem(2), 4)
                .Cells(x, 6) = res
            Else
'                .Cells(x, 6) = Left(s, 3) & "****" & Right(s, 4)
            End If
        Next
    End With
End Sub

Sub 游客电话()
    With Me
        .Range("e:e").NumberFormatLocal = "@"
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For x = 2 To lastRow
            '        If x = 43 Then Stop
            s = Trim(.Cells(x, 5).Value)
            If InStr(s, Chr(10)) And Len(s) > 0 Then
                res = ""
                tem = Split(s, Chr(10))
                For i = 0 To UBound(tem)
                    If Len(tem(i)) > 0 Then
                        res = res & Left(tem(i), 3) & "****" & Right(tem(i), 4) & Chr(10)
                    End If
                Next
                '                .Cells(x, 5) = Trim(Replace(s, Chr(10), ""))
                '                res = Left(tem(0), 3) & "****" & Right(tem(0), 4) & Chr(10) & Left(tem(1), 3) & "****" & Right(tem(1), 4) & Chr(10) & Left(tem(2), 3) & "****" & Right(tem(2), 4)
                .Cells(x, 5) = res
            Else
'                .Cells(x, 5) = Left(s, 3) & "****" & Right(s, 4)
            End If
        Next
    End With
End Sub

 

posted @ 2022-11-22 13:46  依云科技  阅读(249)  评论(0)    收藏  举报