清零公式和非公式单元
我有两个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
现在零不会显示在任何表单上。