excel - 通过多个工作表在相同范围内进行数据验证，但列表不同

Question

我有几张都有相同模板的工作表。每个工作表都有一系列数据验证，其中“列表”对于每个工作表都是唯一的。

'LUNDI (JOUR)
With Sheets("LUNDI (JOUR)").Range("A8:H78").Validation 'The range here is always this
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:="='Index NE PAS SUPPRIMER'!$C$2:$C$11" 'This is what changes, it increments by 3 with every sheet.
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = False
    .ShowError = False
End With

'MARDI (JOUR)
With Sheets("MARDI (JOUR)").Range("A8:H78").Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:="='Index NE PAS SUPPRIMER'!$F$2:$F$11"
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = False
    .ShowError = False
End With

不是为每张纸复制和粘贴此代码，有没有办法遍历所有纸并只更改Formula1:=部分？

标签： excelvbaloops

Answer 1

请尝试此代码：

Sub testSolveValidation()
  Dim sh As Worksheet, wb As Workbook, strFormula As String, rngForm As Range
   Set wb = ActiveWorkbook 'use there the workbook you need
   Set rngForm = Range("$C$2:$C$11")
   For Each sh In wb.Worksheets
        solveValidation sh, rngForm.address
        Set rngForm = rngForm.Offset(, 3)
   Next
End Sub

Sub solveValidation(sh As Worksheet, strFormula As String)
 With sh.Range("A8:H78").Validation 'The range here is always this
    .Delete
    .aDD Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:="='Index NE PAS SUPPRIMER'!" & strFormula 'This is what changes, it increments by 3 with every sheet.
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .errorMessage = ""
    .ShowInput = False
    .ShowError = False
End With