时间戳

首页 > 解决方案 > VBA 向多个工作表添加验证

excel - VBA 向多个工作表添加验证

问题描述

我确定有更好的方法来写这个吗？基本上我只想允许数据范围的数值。该工作簿有多个工作表，因此我只希望代码在工作表名称 WIP 和 HP 上工作。代码工作但我觉得我在重复自己。

sub Validation()

Sheets("AKL WIP").Activate

    Range("J9", Range("J91").End(xlDown).End(xlToRight)).Select
    With Selection.Validation
    .Delete
    .Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:="=ISNUMBER(J9)"
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = "Data Type Error"
    .InputMessage = ""
    .ErrorMessage = "Only Numbers Are Allowed"
    .ShowInput = True
    .ShowError = True
End With

Sheets("AKL HP").Activate

    Range("J9", Range("J91").End(xlDown).End(xlToRight)).Select
    With Selection.Validation
    .Delete
    .Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:="=ISNUMBER(J9)"
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = "Data Type Error"
    .InputMessage = ""
    .ErrorMessage = "Only Numbers Are Allowed"
    .ShowInput = True
    .ShowError = True
End With
End Sub

标签： excelvba

解决方案

只是不要使用Activate- 而是使用 Worksheet 对象

就像是

Sub Validation()
    Dim wb As Workbook
    Dim ws As Worksheet
    
    Set wb = ActiveWorkbook ' or ThisWorkbook
    
    For Each ws In wb.Worksheets
        Select Case ws.Name
            Case "AKL WIP", "AKL HP"
                With ws.Range("J9", ws.Range("J91").End(xlDown).End(xlToRight)).Validation
                    .Delete
                    .Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=ISNUMBER(J9)"
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = "Data Type Error"
                    .InputMessage = ""
                    .ErrorMessage = "Only Numbers Are Allowed"
                    .ShowInput = True
                    .ShowError = True
                End With
        End Select
    Next
End Sub

推荐阅读