清零公式和非公式单元

在这里输入图像说明 我有两个VBA代码,我想结合为单个进程。 需要有人帮助请。

第一编码

Sub DelAllZeros() Application.Calculation = xlCalculationManual Dim ws As Worksheet For Each ws In Worksheets On Error Resume Next Set frange = ws.Cells.SpecialCells(xlCellTypeFormulas) On Error GoTo 0 If Not frange Is Nothing Then For Each c In frange If c.Value = 0 Then c.Formula = ClearContents End If Next c End If Set frange = Nothing Next ws End Sub 

第二码:

 Sub DelAllZeros1() Dim ws As Worksheet For Each ws In Worksheets On Error Resume Next ws.Select Cells.Replace What:="0", Replacement:="", LookAt:=xlWhole, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Next ws End Sub 

第一个代码将清除公式单元格中的“0”,秒代码将清除非公式单元格。

尝试下面的代码(代码注释中的修改)

 Option Explicit Sub DelAllZerosCombined() Application.Calculation = xlCalculationManual Dim ws As Worksheet, c As Range, Rng As Range For Each ws In Worksheets ' set range to occupied range in worksheet (save time in loop) Set Rng = ws.Range("A1:" & ws.Cells.SpecialCells(xlCellTypeLastCell).Address) If Not Rng Is Nothing Then For Each c In Rng If c.Value = 0 Then ' unmerge "merged" cells If c.MergeCells Then c.UnMerge c.ClearContents End If Next c End If Set Rng = Nothing Next ws ' resume setting Application.Calculation = xlCalculationAutomatic End Sub 

试试这个代码。 这将在不改变格式的情况下从表中使用的范围中清除0。

更新:

 Dim ws As Worksheet For Each ws In ActiveWorkbook.Worksheets ws.Cells.Replace what:=0, Replacement:="", _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _ SearchFormat:=False, ReplaceFormat:=False Next ws 

使用文件>选项>高级中的设置,并取消“显示零…”设置。 此设置基于每个工作表,因此,为了使整个工作簿自动化,请将此代码放入ThisWorkbook模块

 Private Sub Workbook_SheetActivate(ByVal Sh As Object) ActiveWindow.DisplayZeros = False End Sub 

现在零不会显示在任何表单上。