对于每个循环相关的选项

时间:2017-05-03 07:56:39

标签: excel vba loops offset

在处理有效的循环时,我想创建一个依赖选择。

用户必须在Sheet2上选择是否通过隐藏行来在sheet1上显示产品。如果他想要展示产品,他必须填写" a"在范围内(" Checkmark")。见下图。

Image1

然后,VBA将使用代码搜索哪些产品具有" a"并获取该单元格的命名范围并添加" 1"之后,sheet1上的命名范围将被隐藏或取消隐藏。例如,如果选择了产品A,VBA将采用命名范围" ProductA"并将其变成" ProductA1"。命名范围" ProductA1"然后将在表1中显示。见下图。

Image2

Image3

第二种选择是产品必须是黑色还是白色。如果选择"黑色"然后将显示工作表1上的某个命名范围,并且"白色"将被隐藏。它也可能是另一种方式。产品本身包含一些名为" Productinfo"的信息。如果" a"已在复选标记下填写第2页,如果未选择产品,则应在表1中为该产品隐藏所有行(命名范围" ProductA1和#34;)。请参阅下面的图像。

Image4

Image5

查看下图中的所有命名范围。

Image6

所以这就是代码:

    Sub Choosingproduct()

Application.ScreenUpdating = False
Dim cell As Range
For Each cell In Range("Checkmark") 'Where user puts in value "a" or not
'Searching for the products that have an "a" in checkmark, then replacing the name and adding a "1" so VBA knows which range to hide or unhide on sheet 1
    Sheets("Sheet1").Range(Replace(cell.Name.Name, cell.Name.Name, cell.Name.Name & "1")).EntireRow.Hidden = Not cell.Value = "a"


    Dim rCell As Range
    For Each rCell In Range("Productchoice")
    If cell.Value = "a" Then
        Sheets("Sheet1").Range(Replace(rCell.Name.Name, rCell.Name.Name, rCell.Name.Name & "black")).EntireRow.Hidden = Not rCell.Value = "Black"
        Sheets("Sheet1").Range(Replace(rCell.Name.Name, rCell.Name.Name, rCell.Name.Name & "white")).EntireRow.Hidden = Not rCell.Value = "White"
    Else
        Sheets("Sheet1").Range(Replace(rCell.Name.Name, rCell.Name.Name, rCell.Name.Name & "black")).EntireRow.Hidden = Not rCell.Value = "Black"
        Sheets("Sheet1").Range(Replace(rCell.Name.Name, rCell.Name.Name, rCell.Name.Name & "white")).EntireRow.Hidden = Not rCell.Value = "White"
    End If

    Next rCell

Next cell

Application.ScreenUpdating = True


End Sub

如何让VBA搜索第二个循环中的每个单独组件?我得到运行时错误1004,应用程序定义或对象定义错误。

更新:

我尝试了不同的代码,这似乎有效:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim cell As Range
Application.ScreenUpdating = False
For Each cell In Range("Checkmark") 'Where user puts in value "a" or not
    Sheets("Sheet1").Range(Replace(cell.Name.Name, cell.Name.Name, cell.Name.Name & "1")).EntireRow.Hidden = Not cell.Value = "a"

        If cell.Value = "a" Then
            If Sheets("Sheet2").Range(Replace(cell.Name.Name, cell.Name.Name, cell.Name.Name & "choice")).Value = "Black" Then
                Sheets("Sheet1").Range(Replace(cell.Name.Name, cell.Name.Name, cell.Name.Name & "choiceblack")).EntireRow.Hidden = False
            Else
                Sheets("Sheet1").Range(Replace(cell.Name.Name, cell.Name.Name, cell.Name.Name & "choiceblack")).EntireRow.Hidden = True
            End If
        End If

        If cell.Value = "a" Then
            If Sheets("Sheet2").Range(Replace(cell.Name.Name, cell.Name.Name, cell.Name.Name & "choice")).Value = "White" Then
                Sheets("Sheet1").Range(Replace(cell.Name.Name, cell.Name.Name, cell.Name.Name & "choicewhite")).EntireRow.Hidden = False
            Else
                Sheets("Sheet1").Range(Replace(cell.Name.Name, cell.Name.Name, cell.Name.Name & "choicewhite")).EntireRow.Hidden = True
            End If
        End If

Next cell

Application.ScreenUpdating = True

End Sub

0 个答案:

没有答案