迭代通过VBA下拉列表

Question

我有三个下拉列表的验证，我试图写一些代码，通过所有的“管理办法”排列可用的迭代。

我可以找出遍历一个列表的第一步（例如Iterate through an Excel dropdown/validation list和其他），但我无法弄清楚如何通过其中三个。

理想情况下，我希望以一种即使添加更多选项也能正常工作的方式进行书写。

为了达到这个目的，我想你需要一种方法来计算每个列表中有多少个选项，然后从0-n迭代。

任何帮助将不胜感激。

Sub LoopThroughList() 
Dim Dropdown1, Dropdown2, Dropdown3 As String 
Dim Range1, Range2, Range3 As Range 
Dim option1, option2, option3 As Range 

' *** SET DROPDOWN LOCATIONS HERE *** 
' *********************************** 

    Dropdown1 = "C6" 
    Dropdown2 = "D6" 
    Dropdown3 = "E6" 

' *********************************** 
' *********************************** 

Set Range1 = Evaluate(Range(Dropdown1).Validation.Formula1) 
Set Range2 = Evaluate(Range(Dropdown2).Validation.Formula1) 
Set Range3 = Evaluate(Range(Dropdown3).Validation.Formula1) 

For Each option1 In Range1 
    For Each option2 In Range2 
     For Each option3 In Range3 

      Worksheets("Sheet1").Range("C6:E6").Copy 
      With Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1) 
       .PasteSpecial Paste:=xlPasteColumnWidths 
       .PasteSpecial Paste:=xlPasteValues 
      End With 


     Next option3 
    Next option2 
Next option1 


End Sub 

目前，我得到这个：

这是通过迭代的作物类型下拉列表，但返回相同的虫害和管理方法。我用来创建下拉列表的代码如下：

Option Explicit 

Private Sub Worksheet_Change(ByVal Target As Range) 

    If Target.Cells.Count > 1 Then Exit Sub 

    If Not Intersect(Target, Range("C6")) Is Nothing Then 
     Range("D6:E6").ClearContents 
    End If 

End Sub 

Answer 1

执行将通过各种可能的组合迭代循环的最简单方法是使用For Each循环。你可以找到更多关于他们的信息here和here和here和here ....... !!! Etcetera ....

这将循环遍历3个下拉列表的每个组合。您需要更改我的代码中下拉列表的位置。

Sub LoopThroughList() 
Dim Dropdown1, Dropdown2, Dropdown3 As String 
Dim Range1, Range2, Range3 As Range 
Dim option1, option2, option3 As Range 

' *** SET DROPDOWN LOCATIONS HERE *** 
' *********************************** 

    Dropdown1 = "D8" 
    Dropdown2 = "E8" 
    Dropdown3 = "F8" 

' *********************************** 
' *********************************** 

Set Range1 = Evaluate(Range(Dropdown1).Validation.Formula1) 
Set Range2 = Evaluate(Range(Dropdown2).Validation.Formula1) 
Set Range3 = Evaluate(Range(Dropdown3).Validation.Formula1) 

For Each option1 In Range1 
    For Each option2 In Range2 
     For Each option3 In Range3 

      ' *** PERFORM CODE HERE *** 
      ' EXAMPLE 
      ' Sheets(1).Cells(1, 1) = option1 
      ' Sheets(1).Cells(2, 1) = option2 
      ' etc... 

     Next option3 
    Next option2 
Next option1 


End Sub 

编辑：

Sub LoopThroughList() 
Dim Dropdown1, Dropdown2, Dropdown3 As String 
Dim Range1, Range2, Range3 As Range 
Dim option1, option2, option3 As Range 

Dim Counter As Long 

Counter = 1 

' *** SET DROPDOWN LOCATIONS HERE *** 
' *********************************** 

    Dropdown1 = "C6" 
    Dropdown2 = "D6" 
    Dropdown3 = "E6" 

' *********************************** 
' *********************************** 

Set Range1 = Evaluate(Range(Dropdown1).Validation.Formula1) 
Set Range2 = Evaluate(Range(Dropdown2).Validation.Formula1) 
Set Range3 = Evaluate(Range(Dropdown3).Validation.Formula1) 

For Each option1 In Range1 
    For Each option2 In Range2 
     For Each option3 In Range3 

      Sheets(2).Cells(Counter, 1) = option1 
      Sheets(2).Cells(Counter, 2) = option2 
      Sheets(2).Cells(Counter, 3) = option3 
      Counter = Counter + 1 

     Next option3 
    Next option2 
Next option1 


End Sub