Question

我在加载项中编写了一个宏，用于在选择范围时更新状态栏：此宏（包含在加载项的＆＃34; thisWorkbook＆＃34;中，SheetSelectionChange)在状态栏上写入选择中第一列和最后一列的矩阵和积。它工作得非常好，但如果有一个有效的过滤器，我希望它跳过隐藏的单元格。这是代码。

Private WithEvents App As Application

Private Sub App_SheetselectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim vStatus As Variant
    Dim nCols As Long
    Dim prod_vett As Variant
    On Error GoTo err_gest_
    With Target
      nCols = .Columns.Count
      If nCols > 1 Then
        prod_vett = Application.Evaluate("sum(" & .Columns(1).Address & "*" & .Columns(nCols).Address & ")")
        vStatus = "Prodotto vettoriale: " & prod_vett
      End If
    End With
    err_gest_:
      If Err.Number <> 0 Then vStatus = False
      Application.StatusBar = vStatus
    End Sub

Private Sub Workbook_Open()
    Application.StatusBar = False
    Set App = Application   'Instantiate application level events

End Sub

如果我使用cicle有一个问题：如果选择工作表中的所有单元格宏太长，无法给我一个结果。我尝试使用

With Target.SpecialCells(xlCellTypeVisible)

但它不起作用。你有其他解决方案吗？

Answer 1

试试这个：

Private WithEvents App As Application

Private Sub App_SheetselectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim vStatus As Variant
    Dim prod_vett As Variant
    '----------------------------
    Dim rng As Excel.Range
    Dim area As Excel.Range
    Dim data As Variant
    Dim row As Long
    Dim firstCol As Integer
    Dim lastCol As Integer
    '----------------------------

    On Error GoTo err_gest_

    Set rng = Target.SpecialCells(xlCellTypeVisible)

    For Each area In rng.Areas
        data = area
        firstCol = LBound(data, 2)
        lastCol = UBound(data, 2)

        For row = LBound(data, 1) To UBound(data, 1)
            prod_vett = prod_vett + data(row, firstCol) * data(row, lastCol)
        Next row

    Next area

    vStatus = "Prodotto vettoriale: " & prod_vett

err_gest_:
      If Err.Number <> 0 Then vStatus = False
      Application.StatusBar = vStatus

End Sub

Private Sub Workbook_Open()
    Application.StatusBar = False
    Set App = Application
End Sub

Answer 2

似乎不起作用。但是当我试图一步一步地走的时候，我发现它有效，但到了＃34; End Sub＆＃34;行返回for each area in rng.Areas，Err.Number变为＆lt;＆gt; 0，因此vStatus变量beacme为false，并且statu栏不会更新。我解决了这个改变：

Private Sub App_SheetselectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim vStatus As Variant
    Dim prod_vett As Variant
    '----------------------------
    Dim rng As Excel.Range
    Dim area As Excel.Range
    Dim data As Variant
    Dim row As Long
    Dim firstCol As Integer
    Dim lastCol As Integer
    '----------------------------

    On Error GoTo err_gest_

    Set rng = Target.SpecialCells(xlCellTypeVisible)

    For Each area In rng.Areas
        data = area
        firstCol = LBound(data, 2)
        lastCol = UBound(data, 2)

            For row = LBound(data, 1) To UBound(data, 1)
                prod_vett = prod_vett + data(row, firstCol) * data(row, lastCol)
            Next row

    Next area
    If prod_vett <> 0 Then
        vStatus = "Prodotto vettoriale: " & prod_vett
            Else: vStatus = False
    End If
    Application.StatusBar = vStatus
    Exit Sub

err_gest_:
vStatus = False
Application.StatusBar = vStatus
End Sub

但是我无法理解为什么在End Sub它不会从宏退出并重新开始...

VBA跳过没有cicle的隐藏单元格

2 个答案: