VBA跳过没有圆圈的隐藏单元格答案

【问题标题】：VBA to skip hidden cells without cicleVBA跳过没有圆圈的隐藏单元格
【发布时间】：2015-07-01 09:17:44
【问题描述】：

我在加载项中编写了一个宏，当您选择范围时会更新状态栏：此宏（包含在插件的“thisWorkbook”中，带有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)

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

【问题讨论】：

标签： vba excel filter hidden

【解决方案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

【讨论】：

【解决方案2】：

好像不行。但是当我尝试逐步进行时，我观察到它可以工作，但是当到达“ End Sub" 行返回到for each area in rng.Areas 并且 Err.Number 变为 0 ，因此 vStatus 变量变为 false 并且状态栏不会更新。我通过此更改解决了：

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 它没有退出宏并重新开始......

【讨论】：