vba 带删除线的字符型和数值型删除；如何修改代码提高宏的运行速度

macro_23 · 发表于 2017-8-22 01:28

1.vba 删除带删除线的字符型和数值型，调试运行正常，不完善的地方，耗时，如果数据大；2. 请教下，如何修改以下代码提高宏的运行速度，非常感谢？

Sub clear_stikethrough_contents()
Dim rng As Range, cl As Range
Dim i As Long
Dim sts As Worksheet
For Each sts In ThisWorkbook.Sheets
Set rng = sts.UsedRange ' Get range of sheet
For Each cl In rng.Cells
'numerical variable
If VarType(cl) = vbDouble And cl.Font.Strikethrough = True Then cl.ClearContents
'charater variable
If VarType(cl) = vbString Then
For i = Len(cl.Value) To 1 Step -1
If cl.Characters(i, 1).Font.Strikethrough Then
cl.Characters(i, 1).Delete
End If
Next i
End If
Next cl
Next sts
End Sub

复制代码

macro_23 · 发表于 2017-8-22 01:30

被同事问到了，她的代码一时半会，找不到错在哪里；所以自己东平西凑写了个半成品，请大家多提意见，O(∩_∩)O谢谢

lsc900707 · 发表于 2017-8-22 06:57

没有附件，应该可以用数组改写，速度会快很多。

macro_23 · 发表于 2017-8-22 10:59

lsc900707 发表于 2017-8-22 06:57
没有附件，应该可以用数组改写，速度会快很多。

已经上传，谢谢

macro_23 · 发表于 2017-8-22 11:02

处理时：注意下，
1、单元格变量的属性，数值型或字符型；
2、一个单元格可能同时含有需要删除和保留的部分，仅仅删除带有删除线格式的内容

lsc900707 · 发表于 2017-8-22 12:06

macro_23 发表于 2017-8-22 11:02
处理时：注意下，
1、单元格变量的属性，数值型或字符型；
2、一个单元格可能同时含有需要删除和保留的 ...

关闭屏幕刷新试试：
Sub clear_stikethrough_contents()
Application.ScreenUpdating = False
For Each sts In Sheets
      Set rng = sts.UsedRange
      For Each cl In rng.Cells
         If VarType(cl) = vbDouble And cl.Font.Strikethrough = True Then cl.ClearContents
         If VarType(cl) = vbString Then
            For i = Len(cl.Value) To 1 Step -1
               If cl.Characters(i, 1).Font.Strikethrough Then
                     cl.Characters(i, 1).Delete
               End If
            Next i
         End If
      Next cl
Next sts
Application.ScreenUpdating = True
End Sub

macro_23 · 发表于 2017-8-23 10:25

lsc900707 发表于 2017-8-22 12:06
关闭屏幕刷新试试：
Sub clear_stikethrough_contents()
Application.ScreenUpdating = False

谢谢哦，朋友，@lsc900707，有空再用改进下

		自动登录	找回密码
密码			免费注册

[求助] vba 带删除线的字符型和数值型 删除 ；如何修改代码 提高宏的运行速度

[求助] vba 带删除线的字符型和数值型删除；如何修改代码提高宏的运行速度