自定义函数--提取单元格内多个被分开的数字

YZC51

Sub 工作表密码破解() '利用Excel的BUG实现清除密码
    '对工作表加密，记住其中Protect的参数变化
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, AllowFiltering:=True
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, AllowFiltering:=True
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, AllowFiltering:=True
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, AllowFiltering:=True
    ActiveSheet.Unprotect '解密
End Sub

FOB_FN_L

YZC51 发表于 2020-3-5 20:53
Sub 工作表密码破解() '利用Excel的BUG实现清除密码
    '对工作表加密，记住其中Protect的参数变化
     ...

晕，你可真会藏东西哟，藏在38楼之下了，有个高人发过，只需两句代码就可破工作表的~~~~~

YZC51

FOB_FN_L 发表于 2020-3-6 07:14
晕，你可真会藏东西哟，藏在38楼之下了，有个高人发过，只需两句代码就可破工作表的~~~~~

谢谢老师关注，2句的我试过，有时候不好用！

YZC51

Function 查找行列(sr, rg As Range, Optional x As Integer)
'‘Function 查找行列(sr As Range, rg As Range, Optional x = 0)
    Dim y   '0、默认，查找行列；1、查找列；2、查找行；3、查找列序号
    Set y = rg.Find(sr)
    c = y.Column
    r = y.Row
    查找行列 = Choose(x + 1, Chr(c + 64) & r, Chr(c + 64), r, c)
End Function

YZC51

Function 查找(rg As Range, rg1 As Range, s&) As String
    Dim r& ‘返回rg相匹配的s列内容
    r = rg1.Find(rg, , , 1).Row
    查找 = Cells(r, s)
End Function

YZC51

Function 查找内容(rg As Range, rg1 As Range, s&) As String
    Dim r&                         '返回与rg相匹配的s列内容
    r = rg1.Find(rg, , , 1).Row
    c = Asc(Split(rg1.Address, "$")(1)) - 65
    查找内容 = Cells(r, s + c)
End Function

YZC51

优化下

Function 查找内容(rg, rg1 As Range, s&, Optional x = 0) As String
    Dim r&, c& '返回与rg相匹配的区域内s列内容;x=0默认,单元格匹配查找;x=1模糊查找
    r = rg1.Find(rg, , , x + 1).Row
    c = Asc(Split(rg1.Address, "$")(1)) - 65
    查找内容 = Cells(r, s + c)
End Function

YZC51

更新下
Function 查找(sr, f, Optional n = 1, Optional x = 0) 'sr 查找内容，f 被查找列   
    Dim rg '返回与ar相匹配的区域内n列的内容;x=0默认,单元格匹配查找;x=1模糊查找
    Set rg = f.Find(sr, , , x + 1)
    查找 = rg.offset(, n).Value
End Function

YZC51

Public Sub ss() '批量修改表单复选框标题
    For i = 289 To 301
        n = n + 1
        Sheet1.Shapes("复选框 " & i).Select
        Sheet1.Shapes("复选框 " & i).TextFrame.Characters.Text = "NewText" & Cells(n, 7)
    Next i
End Sub

YZC51

附件
通过VBA生成复选框及标题.rar (11.1 KB, 下载次数: 14)

2020-3-10 21:36 上传

点击文件名下载附件