问双击工作表中的单元格可在另一个工作表中生成筛选数据
EN

Stack Overflow用户

提问于 2021-07-01 09:29:30

回答 2查看 105关注 0票数 1

我目前正在编写一个工作簿，该工作簿将提供制造业中选定产品的概述。

我正在尝试做的是构建VBA代码，以允许在表范围内双击以过滤不同工作表中的数据。为了说明，我想要应用此代码的表的范围是从B2到Y40。在双击单元格B2时，我想根据另一个工作表中B1和A2中的数据应用两个单独的过滤器。双击单元格D38，我想让它基于D1和A38应用2个不同的过滤器。

我是VBA新手，不确定这是不是可以实现的。

我在这个网站上提出的一个类似的问题中发现了这段代码。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    'Update Table14 to your table name
    'Update Field to column number of the field you are filtering
    'Update Sheet7 to reference the sheet containing your table
    'Change on to the column number where your click should cause this action
    If ActiveCell.Column = 1 Then
    Sheet7.ListObjects("Table14").Range.AutoFilter Field:=1, Criteria1:=ActiveCell.Value
    'Update Sheet7 to reference the sheet containing your table
    Sheet7.Activate
    End If
End Sub

由于我对VBA知之甚少，所以我想知道是否可以将ActiveCell.Column更改为表范围，并更改条件以获得上面提到的所需过滤结果。

excel

vba

人脸核身产品特惠

用户政务民生、金融、通信运营商等场景，接入全面，安全可靠新用户3折起

回答 2

Stack Overflow用户

回答已采纳

发布于 2021-07-02 04:42:19

在另一个工作表中筛选

Option Explicit

Private Sub Worksheet_BeforeDoubleClick( _
        ByVal Target As Range, _
        Cancel As Boolean)

    Const dName As String = "Sheet2" ' adjust destination tab name
    Const dField1 As Long = 6 ' 6 is "F"
    Const dField2 As Long = 11 ' 11 is "K"

    Dim srg As Range: Set srg = Range("A1").CurrentRegion
    Dim irg As Range: Set irg = srg _
        .Resize(srg.Rows.Count - 1, srg.Columns.Count - 1).Offset(1, 1)

    If Intersect(Target, irg) Is Nothing Then Exit Sub

    Dim dCrit1 As String: dCrit1 = CStr(Cells(1, Target.Column).Value)
    Dim dCrit2 As String: dCrit2 = CStr(Cells(Target.Row, 1).Value)

    Dim dws As Worksheet: Set dws = Me.Parent.Worksheets(dName)
    If dws.AutoFilterMode Then
        dws.AutoFilterMode = False
    End If
    
    Dim drg As Range: Set drg = dws.Range("A1").CurrentRegion
    drg.AutoFilter Field:=dField1, Criteria1:=dCrit1
    drg.AutoFilter Field:=dField2, Criteria1:=dCrit2
    
    'Cancel = True
    dws.Activate

End Sub

票数 0

Stack Overflow用户

发布于 2021-07-01 10:15:32

请尝试下一次更新的代码(根据您所说的)。但是我仍然有一些疑问，你需要在Sheet7中过滤Table24 ...请澄清这一点。

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If Not Intersect(Target, Range("B2:Y40")) Is Nothing Then
        Dim Crit1 As String, Crit2 As String
        Crit1 = cells(1, Target.Column).value
        Crit2 = Cells(Target.Row, 1).Value
        'Update "Table14", using your real table name. Or a range, if no table is involved...
        'The filter field must also be updated according to your need (now it is 1 - first table column)
        Sheet7.ListObjects("Table14").Range.AutoFilter field:=1, Criteria1:=Crit1
        Sheet7.ListObjects("Table14").Range.AutoFilter field:=2, Criteria1:=Crit2
        'Update Sheet7 to reference the sheet containing your table!
        Cancel = True  'otherwise, you cannot activate another sheet if the double clicked cell will be in edit mode
        Sheet7.Activate
   End If
End Sub