|
楼主 |
发表于 2024-5-20 11:07
|
显示全部楼层
使用VBA代码删除工作表中的非打印控制符
Sub 正则替换()
Dim X, i, j, a
Dim 查找 As String, 替换 As String, 提取 As String
Dim matches As Object
Dim match As Object
On Error Resume Next
Call 查替保护公式
Application.Calculation = xlCalculationManual '将计算方式改为手动
Application.ScreenUpdating = False
ActiveSheet.Unprotect ("")
ActiveSheet.UsedRange.Replace What:=" ", Replacement:="ycyok", LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
ActiveSheet.UsedRange.Replace What:=" ", Replacement:="YCYOK", LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False '取消筛选,以防出错
查找 = "\s" '
替换 = "" '
dyh = "'"
Leftchr = Left(替换, 7)
Rightchr = Right(替换, 7)
nl = Mid(Leftchr, 5, 2)
nR = Mid(Rightchr, 5, 2)
If Mid(nl, 2, 1) = ")" Then nl = Mid(nl, 1, 1): Leftchr = Left(替换, 6)
If Mid(nR, 2, 1) = ")" Then nR = Mid(nR, 1, 1): Rightchr = Right(替换, 6)
If Left(替换, 1) = " " Or Right(替换, 1) = " " Or Left(替换, 1) = " " Or Right(替换, 1) = " " Then Exit Sub
Dim RegEx, Cel
Set RegEx = CreateObject("VBSCRIPT.REGEXP") 'RegEx为建立正则表达式
With RegEx
.Global = True '设置全局可用
.IgnoreCase = True
.MultiLine = True
.Pattern = 查找
End With
a = Selection.Address
If InStr(a, ":") = 0 Then
If ActiveCell.Address = "$A$1" Then [b1].Select
ActiveSheet.UsedRange.Activate
a = Selection.Address
End If
arr1 = Split(a, "$")
If arr1(1) Like "*:" Then
If IsNumeric(Mid(arr1(1), 1, Len(arr1(1)) - 1)) Then
Y = ActiveSheet.UsedRange.Column
X = ActiveSheet.UsedRange.Columns.Count + Y - 1
Y = Split(Cells(1, Y).Address, "$")(1)
X = Split(Cells(1, X).Address, "$")(1)
Z = ActiveSheet.UsedRange.Rows.Count
n = arr1(2)
If Z < n Then arr1(2) = Z
a = "$" & Y & "$" & arr1(1) & "$" & X & "$" & arr1(2)
Else
a = "$" & Mid(arr1(1), 1, Len(arr1(1)) - 1) & "$" & ActiveSheet.UsedRange.Row & ":$" & arr1(2) & "$" & ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Row - 1
End If
End If
If Range(a).Rows.Count + Range(a).Columns.Count >= 2 Then
arr = Range(a).Value
For i = 1 To UBound(arr, 2)
For j = 1 To UBound(arr)
F2 = RegEx.Replace(arr(j, i), Leftchr & 替换 & Rightchr)
If (Left(F2, 1) = 0 And Left(F2, 2) <> "0.") Then '保护0开头的文本数字不被修改成数值型
arr(j, i) = dyh & F2
Else
If Val(F2) > 1E+15 Then arr(j, i) = "'" & F2 Else arr(j, i) = F2 '保护15位以上文本数字
End If
Next j
Next i
Range(a).Value = arr
Else
Range(a) = RegEx.Replace(Range(a), Leftchr & 替换 & Rightchr)
End If
ActiveSheet.Unprotect ("")
ActiveSheet.UsedRange.Replace What:="ycyok", Replacement:=" ", LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
ActiveSheet.UsedRange.Replace What:="YCYOK", Replacement:=" ", LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
If ActiveSheet.ProtectContents = False Then '如果当前表未保护
Pass = ""
ActiveSheet.Protect Password:=Pass '利用原密码工作表保护
End If
Set matches = Nothing
Application.Calculation = xlCalculationAutomatic '恢复自动计算
Application.ScreenUpdating = True
End Sub
Sub 查替保护公式()
On Error Resume Next
If ActiveSheet.ProtectContents = True Then '如果当前表已保护
Pass = Application.InputBox("请输入解锁密码,如果没有就保持空白:", "解锁密码", "", , , , , 2) '输入解锁密码
End If
NewPass = ""
ActiveSheet.Unprotect Pass '利用原密码解除工作表保护
If Err.Number = 1004 Then MsgBox "当前表不存在公式": Exit Sub '如果错误则提示,并退出程序
Cells.Locked = False '取消所有单元格的锁定属性
Cells.FormulaHidden = False '将隐藏公式也取消
With Cells.SpecialCells(xlCellTypeFormulas, 23) '对公式区域进行操作
.Locked = True '如果密码正确则锁定所有公式区
.FormulaHidden = False '公式可见
'保护工作表(允许用设置格式、编辑对象等等)
ActiveSheet.Protect Password:=NewPass, DrawingObjects:=True, CONTENTS:=True, Scenarios:=True, _
AllowFormattingCells:=False, AllowFormattingColumns:=False, AllowFormattingRows:=False, _
AllowInsertingColumns:=False, AllowInsertingRows:=False, AllowInsertingHyperlinks:=False, _
AllowDeletingColumns:=False, AllowDeletingRows:=False, AllowSorting:=True, _
AllowFiltering:=False, AllowUsingPivotTables:=False
ActiveSheet.EnableSelection = xlNoRestrictions '锁定的单元格能选定
End With
End Sub
|
|