我有4个数据验证下拉列表,我想使用a为每个循环迭代4个数据验证下拉列表的所有可能值并将结果复制到工作表 .
下降在细胞H3和H4以及U3和U4中 . H3和U3包含相同的值,H4和U4包含相同的值 .
首先,我想检查一下工作表中是否有数据验证列表 .
然后我想迭代4个下拉值的所有可能值并将结果保存在新的工作表中!
我在stackoverflow上发现了一个线程Iterate through VBA dropdown list
从该线程我使用以下代码:
Sub LoopThroughList()
Dim Dropdown1, Dropdown2, Dropdown3, Dropdown4 As String
Dim Range1, Range2, Range3, Range4 As Range
Dim option1, option2, option3, option4 As Range
Dim Counter As Long
Counter = 1
' *** SET DROPDOWN LOCATIONS HERE ***
' ***********************************
Dropdown1 = "H3"
Dropdown2 = "H4"
Dropdown2 = "U3"
Dropdown2 = "U4"
' ***********************************
' ***********************************
Set Range1 = Evaluate(Range("H3").Validation.Formula1)
Set Range2 = Evaluate(Range("H4").Validation.Formula1)
Set Range3 = Evaluate(Range("U3").Validation.Formula1)
Set Range4 = Evaluate(Range("U4").Validation.Formula1)
For Each option1 In Range1
For Each option2 In Range2
For Each option3 In Range3
For Each option4 In Range4
Sheets(2).Cells(Counter, 1) = option1
Sheets(2).Cells(Counter, 2) = option2
Sheets(2).Cells(Counter, 3) = option3
Sheets(2).Cells(Counter, 3) = option4
Counter = Counter + 1
Debug.Print option1, option2, option3, option4
Next option4
Next option3
Next option2
Next option1
End Sub
更新:
我在https://www.ozgrid.com/forum/forum/help-forums/excel-general/134028-loop-through-excel-drop-down-list-and-copy-paste-the-value?t=190022上发现了另一个线程,它使用VBA循环遍历两个数据验证下拉列表 .
选项明确
Sub LoopThroughDv()
Dim dvCell As Range
Dim inputRange As Range
Dim c As Range
Dim i As Long
'Which cell has data validation
Set dvCell = Worksheets("Input Output").Range("I4")
'Determine where validation comes from
Set inputRange = Evaluate(dvCell.Validation.Formula1)
i = 0
'Begin our loop
Application.ScreenUpdating = True
For Each c In inputRange
dvCell = c.Value
' Worksheets("Output").Cells(i, "A").Value = dvCell
'Worksheets("Output").Cells(i, "A").Value = Worksheets("Input Output").Range("A1").Value
MsgBox dvCell
Debug.Print dvCell
i = i + 1
Next c
Application.ScreenUpdating = True
End Sub
如何改进此代码?此外,是否可以将整个工作表保存在循环中?对于每个循环,我的vlookups的值发生了变化,我想将信息复制到一个新的工作表,最后在一个pivottable中使用它 .
另外,在一个帖子中发现了这段代码loop through multiple data validation lists
Sub CopyPaste()
Application.ScreenUpdating = False
Dim inputRange1, inputRange2 As Range
Dim option1, option2 As Range
Set inputRange1 =
Evaluate(Worksheets("Scenario").Range("TabSelection").Validation.Formula1)
Set inputRange2 =
Evaluate(Worksheets("Scenario").Range("IndexSelection").Validation.Formula1)
For Each option1 In inputRange1
Worksheets("Scenario").Range("TabSelection").Value = option1.Value
For Each option2 In inputRange2
ActiveSheet.EnableCalculation = True
Worksheets("Scenario").Range("IndexSelection").Value = option2.Value
Worksheets("Scenario").Range("CopyRange").Copy
With Sheets("Paste").Range("A" & Rows.Count).End(xlUp).Offset(2)
.PasteSpecial Paste:=xlPasteColumnWidths
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
Next option2
Next option1
Application.ScreenUpdating = True
End Sub
我试图最小化代码:
Sub LoopThroughDv()
Application.ScreenUpdating = True
Dim inputRange1, inputRange2 As Range
Dim option1, option2 As Range
Set inputRange1 = Evaluate(Worksheets("Input Output").Range("I4").Validation.Formula1)
Set inputRange2 = Evaluate(Worksheets("Input Output").Range("M4").Validation.Formula1)
ActiveSheet.EnableCalculation = True
For Each option1 In inputRange1
ActiveSheet.EnableCalculation = True
Debug.Print option1
Worksheets("Input Output").Range("D10").Value = option1.Value
For Each option2 In inputRange2
Debug.Print option2
Worksheets("Input Output").Range("E10").Value = option2.Value
Next option2
Next option1
Application.ScreenUpdating = True
End Sub
Excel - Data Validation list from filtered table这个帖子也很有用!
我找到另一个带有指令Determine if cell contains data validation的线程来查找数据验证单元格 . 现在我有了数据验证单元格的地址,formula1和incelldropdown .
如何逐步循环数据验证?
Option Explicit
Public Sub ShowValidationInfo()
Dim rngCell As Range
Dim lngValidation As Long
For Each rngCell In ActiveSheet.UsedRange
lngValidation = 0
On Error Resume Next
lngValidation = rngCell.SpecialCells(xlCellTypeSameValidation).Count
On Error GoTo 0
If lngValidation <> 0 Then
Debug.Print rngCell.Address
Debug.Print rngCell.Validation.Formula1
Debug.Print rngCell.Validation.InCellDropdown
End If
Next
End Sub
更新:
我发现这个代码做了我想要的,但它只用于一个数据验证下拉 . 如何修改此代码以使用2或#n下拉列表?
Sub LoopThroughDv()
Dim dvCell As Range
Dim inputRange As Range
Dim c As Range
Dim i As Long
'Which cell has data validation
Set dvCell = Worksheets("Input Output").Range("I4")
'Determine where validation comes from
Set inputRange = Evaluate(dvCell.Validation.Formula1)
i = 0
'Begin our loop
Application.ScreenUpdating = True
For Each c In inputRange
dvCell = c.Value
' Worksheets("Output").Cells(i, "A").Value = dvCell
'Worksheets("Output").Cells(i, "A").Value = Worksheets("Input Output").Range("A1").Value
MsgBox dvCell
Debug.Print dvCell
i = i + 1
Next c
Application.ScreenUpdating = True
End Sub
更新2018 07 24:
我仍在尝试遍历我的4个数据验证列表,有人可以帮我调整下面的代码以使用2个数据验证列表吗?
Option Explicit
Sub LoopThroughValidationList()
Dim lst As Variant
Dim rCl As Range
Dim str As String
Dim iX As Integer
str = Range("B1").Validation.Formula1
On Error GoTo exit_proc:
If Left(str, 1) = "=" Then
str = Right(str, Len(str) - 1)
For Each rCl In Worksheets(Range(str).Parent.Name).Range(str).Cells
Range("B1").Value = rCl.Value
Next rCl
Else
lst = Split(str, ",")
For iX = 0 To UBound(lst)
Range("B1").Value = lst(iX)
Next iX
End If
Exit Sub
exit_proc:
MsgBox "No validation list ", vbCritical, "Error"
End Sub
1 回答
即使使用
INDEX
和MATCH
的命名范围无效,此代码仍然有效 .ExtractDataValidationList:Sub
用法