如何电话号码换成密文？

tanglf188

风雨相随3 发表于 2023-1-12 16:43
如果秘文个数和位置 不确定，能做出不？

没问题设置一个加密校验位就行了

洋务德雷

这样的加密不是很轻易的就解除了吗？为何要加密呢？

ykcbf1100

天地一相 发表于 2023-1-12 17:03
加密时能设置加密几位（如9位），加密位置随机，会更好玩。

对于手机号加密，一般都是只加密中间4位的。
要加密9位，技术上没问题，全部加密都行。

zpy2

aes256加密
=webservice("http://e.anyoupin.cn/eh3/?SecuEncode~0~aa~13506598106")

解密
=webservice("http://e.anyoupin.cn/eh3/?SecuEncode~1~aa~RDwGBDbRWzu/bAycr6eu7w==")

1121228509

Option Explicit
Sub 电话号码加密()
Dim fk As Long, xh As Long, xhh As Long
Dim Arr As Variant, Brr As Variant
fk = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row - 1
Arr = Sheets("Sheet1").Range("A2").Resize(fk, 1)
Brr = Array("g", "a", "l", "o", "r", "h", "I", "y", "k", "v")
ReDim Crr(1 To fk, 1 To 1) As Variant
For xh = 1 To fk
    For xhh = 1 To Len(Arr(xh, 1))
        If xhh > 3 And xhh < 8 And IsNumeric(Mid(Arr(xh, 1), xhh, 1)) = True Then
            Crr(xh, 1) = Crr(xh, 1) & Brr(Mid(Arr(xh, 1), xhh, 1))
        Else
            Crr(xh, 1) = Crr(xh, 1) & Mid(Arr(xh, 1), xhh, 1)
        End If
    Next xhh
Next xh
Sheets("Sheet1").Range("A2").Resize(fk, 1) = Crr
End Sub

Sub 密电话号码解密()
Dim fk As Long, xh As Long, xhh As Long
Dim Arr As Variant, Brr As Variant
fk = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row - 1
Arr = Sheets("Sheet1").Range("A2").Resize(fk, 1)
Brr = Array("g", "a", "l", "o", "r", "h", "I", "y", "k", "v")
ReDim Crr(1 To fk, 1 To 1) As Variant
For xh = 1 To fk
    For xhh = 1 To Len(Arr(xh, 1))
        If IsNumeric(Mid(Arr(xh, 1), xhh, 1)) = True Then
            Crr(xh, 1) = Crr(xh, 1) & Mid(Arr(xh, 1), xhh, 1)
        Else
            Crr(xh, 1) = Crr(xh, 1) & Application.Match(Mid(Arr(xh, 1), xhh, 1), Brr, 0) - 1
        End If
    Next xhh
Next xh
Sheets("Sheet1").Range("A2").Resize(fk, 1) = Crr
End Sub


电话号码加密与解密.rar (20.2 KB, 下载次数: 2)

2023-1-14 20:05 上传

点击文件名下载附件

aman1516

洋务德雷 发表于 2023-1-12 22:22
这样的加密不是很轻易的就解除了吗？为何要加密呢？

VBA层面就不要讨论加密了，何况加密后还要还原...
要稍为遮下眼就把密码字典与密匙放到注册表里面去，防下君子，
又或者，明文与原文两份文档，明文档随便瞎替换乱码，给别人用，原文档自己用，谁也破解不了