Excel VBA对于带有数据验证列表的每个循环 [英] Excel VBA For each loop with data validation lists
问题描述
我有4个数据验证下拉菜单,我想对每个循环使用a来遍历4个数据验证下拉菜单的所有可能值,并将结果复制到工作表中.
I have 4 data validation drop downs and I want to use a for each loop to iterate through all possible values of the 4 data validation drop downs and copy the result to a worksheet.
下拉列表位于单元格H3和H4以及U3和U4中. H3和U3包含相同的值,而H4和U4包含相同的值.
The drop downs are in cells H3 and H4 and U3 and U4. H3 and U3 contains identical values and H4 and U4 contains identical values.
首先,我想检查我的工作表中是否有数据验证列表.
First I would like to check if there are data validation list in my worksheet.
然后,我要遍历4个下拉列表值的所有可能值,并将结果保存在新的工作表中!
Then I would like to iterate through all possible values of the 4 drop downs values and save the result in a new worksheet!
我在stackoverflow 在VBA下拉列表中进行迭代
I found a thread here on stackoverflow Iterate through VBA dropdown list
并且从该线程中,我正在使用以下代码:
and from that thread I am using the following code:
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
更新:
I found another thread on https://www.ozgrid.com/forum/forum/help-forums/excel-general/134028-loop-through-excel-drop-down-list-and-copy-paste-the-value?t=190022 which loops through two data validation drop down lists with 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的值都会更改,我想将信息复制到新的工作表中,最后在数据透视表中使用它.
How can I improve on this code? Also, would it be possible to save the entire worksheet under the loop? For each loop the value of my vlookups change and I want to copy the information to a new worksheet and finally use it in a pivottable.
此外,还在线程循环遍历多个数据验证中找到了此代码列表
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
我找到了另一个带有指令确定单元格是否包含数据验证的线程查找数据验证单元.现在,我有了数据验证单元的地址,公式1和incelldropdown.
I found another thread with instructions Determine if cell contains data validation to find data validation cells. Now that I have the address, formula1 and incelldropdown of my data validation cells.
如何逐步浏览数据验证?
How can I loop through the data validation step by step?
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下拉菜单?
I have found that this code does what I want, however it only does it for one data validation drop down. How can I modify this code to use 2 or #n dropdowns?
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年7月24日:
UPDATE 2018 07 24:
我仍在尝试遍历4个数据验证列表,有人可以帮助我修改下面的代码以使用2个数据验证列表吗?
I am still trying to loop through my 4 data validation lists, Could someone help me adapt the code below to use 2 data validation lists?
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
推荐答案
即使使用INDEX
和MATCH
的命名范围无效,此代码仍将起作用.
This code will still work even if the named ranges using INDEX
and MATCH
are invalid.
Sub ExtractDataValidationList(Source As Range, Optional TargetWorkSheet As Worksheet)
Dim cell As Range, rValidation As Range
Dim list As Object, item As Variant, values As Variant
On Error Resume Next
Set rValidation = Source.SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0
If rValidation Is Nothing Then
MsgBox "No Data Validation Found"
Else
Set list = CreateObject("System.Collections.ArrayList")
For Each cell In rValidation
On Error Resume Next
values = Range(cell.Validation.Formula1).Value
If Err.Number <> 0 Then values = Split(cell.Validation.Formula1, ",")
On Error GoTo 0
For Each item In values
If Not list.Contains(item) Then list.Add item
Next
Next
If list.Count = 0 Then
MsgBox "No Items in Data Validation Formula1"
Else
list.Sort
If TargetWorkSheet Is Nothing Then Set TargetWorkSheet = Worksheets.Add
TargetWorkSheet.Range("A1").Resize(list.Count).Value = WorksheetFunction.Transpose(list.ToArray)
End If
End If
End Sub
用法
ExtractDataValidationList ActiveSheet.Cells
这篇关于Excel VBA对于带有数据验证列表的每个循环的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!