如何使用我定义的范围变量列表进行循环以运行此代码15次? [英] How can I make a loop to run this code 15 times using a list of the range variables I defined?

问题描述

我在(当前)Worksheet_Change事件上为15个静态范围中的每一个运行相同的代码.每个范围均由其自身评估.

I am running the same code for each of 15 static Ranges on the (current) Worksheet_Change event. Each range is evaluated by itself.

我仅在每个单独的范围中检查重复项，但不检查范围.但是，在过程结束之前，必须检查所有范围(或直到执行操作).

I am checking for duplicates, but not across ranges, only in each individual range. But all ranges must be checked (or up until action) before the procedure ends.

用户可以从动态下拉列表中为所有单元格填充单元格.

The cells are being filled by user selections from dynamic drop down lists for all cells.

我要发布的代码可以正常工作.如何使用我定义的范围变量列表进行循环以运行相同的代码15次?

The code I am posting works just as I need it to. How can I make a loop to run the same code 15 times using a list of the range variables I defined?

我想简化代码，以便在更改代码时不必在15个地方进行更改.

I want to simplify the code so that if I make a change to the code I don't have to change it in 15 places.

我尝试了几种版本的研究代码来使循环代码起作用，但是多个If语句使我很难为循环找到正确的结构.

I have tried several versions of researched code to make a looping code functional, but the multiple If statements make it hard for me to find the right structure for a loop.

我最终放弃了，并在一个有效的If-ElseIf语句中将代码复制了15次.

I finally gave up and copied the code 15 times in an If - ElseIf statement which works.

Private Sub Worksheet_Change(ByVal Target As Range)

'Define your variables.
Dim Sun1AM As Range, Sun1PM As Range, Wed1PM As Range
Dim Sun2AM As Range, Sun2PM As Range, Wed2PM As Range
Dim Sun3AM As Range, Sun3PM As Range, Wed3PM As Range
Dim Sun4AM As Range, Sun4PM As Range, Wed4PM As Range
Dim Sun5AM As Range, Sun5PM As Range, Wed5PM As Range

'Set the ranges where you want to prevent duplicate entries.
Set Sun1AM = Range("C4:C14")
Set Sun1PM = Range("C17:C21")
Set Wed1PM = Range("C24:C28")
Set Sun2AM = Range("E4:E14")
Set Sun2PM = Range("E17:E21")
Set Wed2PM = Range("E24:E28")
Set Sun3AM = Range("G4:G14")
Set Sun3PM = Range("G17:G21")
Set Wed3PM = Range("G24:G28")
Set Sun4AM = Range("I4:I14")
Set Sun4PM = Range("I17:I21")
Set Wed4PM = Range("I24:I28")
Set Sun5AM = Range("K4:K14")
Set Sun5PM = Range("K17:K21")
Set Wed5PM = Range("K24:K28")


'See if target is in any of the ranges defined above and check for 
'duplicates range by range.
If Not Intersect(Target, Sun1AM) Is Nothing Then
    If Target.Cells.Count > 1 Then Exit Sub
        If WorksheetFunction.CountIf(Sun1AM, Target.Value) > 1 Then _
           MsgBox Target.Value & " is already used.", vbInformation, _ 
           "Duplicate Entry!"

ElseIf Not Intersect(Target, Sun1PM) Is Nothing Then
    If Target.Cells.Count > 1 Then Exit Sub
        If WorksheetFunction.CountIf(Sun1PM, Target.Value) > 1 Then _
           MsgBox Target.Value & " is already used.", vbInformation, _
           "Duplicate Entry!"

ElseIf Not Intersect(Target, Wed1PM) Is Nothing Then
    If Target.Cells.Count > 1 Then Exit Sub
        If WorksheetFunction.CountIf(Wed1PM, Target.Value) > 1 Then _
           MsgBox Target.Value & " is already used.", vbInformation, _
           "Duplicate Entry!"

ElseIf Not Intersect(Target, Sun2AM) Is Nothing Then
    If Target.Cells.Count > 1 Then Exit Sub
        If WorksheetFunction.CountIf(Sun2AM, Target.Value) > 1 Then _
           MsgBox Target.Value & " is already used.", vbInformation, _
           "Duplicate Entry!"

ElseIf Not Intersect(Target, Sun2PM) Is Nothing Then
    If Target.Cells.Count > 1 Then Exit Sub
        If WorksheetFunction.CountIf(Sun2PM, Target.Value) > 1 Then _
           MsgBox Target.Value & " is already used.", vbInformation, _
           "Duplicate Entry!"

ElseIf Not Intersect(Target, Wed2PM) Is Nothing Then
    If Target.Cells.Count > 1 Then Exit Sub
        If WorksheetFunction.CountIf(Wed2PM, Target.Value) > 1 Then _
           MsgBox Target.Value & " is already used.", vbInformation, _
           "Duplicate Entry!"

ElseIf Not Intersect(Target, Sun3AM) Is Nothing Then
    If Target.Cells.Count > 1 Then Exit Sub
        If WorksheetFunction.CountIf(Sun3AM, Target.Value) > 1 Then _
           MsgBox Target.Value & " is already used.", vbInformation, _
           "Duplicate Entry!"

ElseIf Not Intersect(Target, Sun3PM) Is Nothing Then
    If Target.Cells.Count > 1 Then Exit Sub
        If WorksheetFunction.CountIf(Sun3PM, Target.Value) > 1 Then _
           MsgBox Target.Value & " is already used.", vbInformation, _
           "Duplicate Entry!"

ElseIf Not Intersect(Target, Wed3PM) Is Nothing Then
    If Target.Cells.Count > 1 Then Exit Sub
        If WorksheetFunction.CountIf(Wed3PM, Target.Value) > 1 Then _
           MsgBox Target.Value & " is already used.", vbInformation, _
           "Duplicate Entry!"

ElseIf Not Intersect(Target, Sun4AM) Is Nothing Then
    If Target.Cells.Count > 1 Then Exit Sub
        If WorksheetFunction.CountIf(Sun4AM, Target.Value) > 1 Then _
           MsgBox Target.Value & " is already used.", vbInformation, _
           "Duplicate Entry!"

ElseIf Not Intersect(Target, Sun4PM) Is Nothing Then
    If Target.Cells.Count > 1 Then Exit Sub
        If WorksheetFunction.CountIf(Sun4PM, Target.Value) > 1 Then _
           MsgBox Target.Value & " is already used.", vbInformation, _
           "Duplicate Entry!"

ElseIf Not Intersect(Target, Wed4PM) Is Nothing Then
    If Target.Cells.Count > 1 Then Exit Sub
        If WorksheetFunction.CountIf(Wed4PM, Target.Value) > 1 Then _
           MsgBox Target.Value & " is already used.", vbInformation, _
           "Duplicate Entry!"

ElseIf Not Intersect(Target, Sun5AM) Is Nothing Then
    If Target.Cells.Count > 1 Then Exit Sub
        If WorksheetFunction.CountIf(Sun5AM, Target.Value) > 1 Then _
           MsgBox Target.Value & " is already used.", vbInformation, _
           "Duplicate Entry!"

ElseIf Not Intersect(Target, Sun5PM) Is Nothing Then
    If Target.Cells.Count > 1 Then Exit Sub
        If WorksheetFunction.CountIf(Sun5PM, Target.Value) > 1 Then _
           MsgBox Target.Value & " is already used.", vbInformation, _
           "Duplicate Entry!"

ElseIf Not Intersect(Target, Wed5PM) Is Nothing Then
    If Target.Cells.Count > 1 Then Exit Sub
        If WorksheetFunction.CountIf(Wed5PM, Target.Value) > 1 Then _
           MsgBox Target.Value & " is already used.", vbInformation, _
           "Duplicate Entry!"

Else
    Exit Sub

End If

End Sub

这有效，但是很难管理.请有人启发我一个简单的循环.我将复制此工作表，每个月进行一次新复制，因此代码必须保持为当前工作表"并可以在用户正在处理的任何工作表上使用.

This works but very hard to manage. Someone please enlighten me to a nice simple loop. I will be copying this sheet, making a new copy each month so the code must remain "current sheet" and work on any sheet the user is working on.

非常感谢！

推荐答案

由蒂姆·威廉姆斯提供(见上文) https ://stackoverflow.com/users/478884/tim-williams

Answer courtesy of Tim Williams (see post above) https://stackoverflow.com/users/478884/tim-williams

注意:此代码检查用户是否在C4:C14，C17:C21，C24:C28，E4:E14，E17:E21，E24:E28，G4:G14，G17:G21， G24:G28， 仅限I4:I14，I17:I21，I24:I28，K4:K14，K17:K21，K24:C28.

Note: this code checks for the user entering a duplicate value in the ranges C4:C14,C17:C21,C24:C28,E4:E14,E17:E21,E24:E28,G4:G14,G17:G21,G24:G28, I4:I14,I17:I21,I24:I28,K4:K14,K17:K21,K24:C28 only.

这些是每月动态分配日历上的静态分配范围.此代码不会删除或防止重复输入.它仅通过vbInformation消息框通知用户在给定的一天给一个人分配了多个任务.它通知某人"已被使用，用户可以选择离开或编辑副本.该工作表(主副本)每月被复制为新的空白工作表，填写作业并分发打印的副本.工作表本身会动态更改，以选择每月和每年一次以反映正确的日历日期.此代码旨在在活动"工作表上工作，因为一次只分配一个月(一张工作表)，而过去的几个月则保留为参考文件.

These are static ranges of assignments on a dynamic monthly assignment calendar. This code does not delete or prevent a duplicate entry. It only advises the user with a vbInformation message box that a person has been assigned more than one task on a given day. It notifies that "someone" has already been used, and the user may choose to leave or edit the duplicate. This sheet (a master copy) is copied as a new blank sheet for each month, assignments are filled in and printed copies are distributed. The sheet itself changes dynamically to reflect the proper calendar dates once a month and year are chosen. This code is designed to work on the "active" worksheet since only one month (one sheet) is being assigned at a time, and past months remain as reference documents.

Private Sub Worksheet_Change(ByVal Target As Range)    'By Tim Williams

Dim rng As Range, a As Range

If Target.CountLarge > 1 Then Exit Sub 'only need this test once
If IsEmpty(Target) Then Exit Sub       'added check for empty target on delete action

Set rng = Range("C4:C14,C17:C21,C24:C28") 'start here
Do While rng.Column <= 11
    'loop over the areas in the range
    For Each a In rng.Areas
        If Not Intersect(Target, a) Is Nothing _
           And WorksheetFunction.CountIf(a, Target.Value) > 1 Then
            MsgBox Target.Value & " is already used", _
            vbInformation, "Duplicate Entry!"

            Exit Do
        End If    

    Next a
    Set rng = rng.Offset(0, 2) 'move two columns to the right
Loop

End Sub

非常感谢Tim给我展示了如何将庞大的代码简化为令人难以置信的整洁而简单的例程.

Many thanks to Tim for showing me how to simplify my bulky code to an incredibly neat and simple routine.

这篇关于如何使用我定义的范围变量列表进行循环以运行此代码15次?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！