将范围的可见单元格添加到数组

Question

我正在尝试将范围内可见单元格的值获取到数组中。

我的代码使数组携带值，直到第一个不可见单元格停止。

Public Function ListeMaschinen() As Variant

Dim Auswahl As Range

With Sheets("qry_TechnischesDatenblatt")
Set Auswahl = .Range(.Range("A2:B2"), .Range("A2:B2").End(xlDown)).SpecialCells(xlCellTypeVisible)
End With

ListeMaschinen = Auswahl

End Function

如果我选择范围，它会显示我想要标记的所有单元格。

Auswahl.Select

Answer 1

这里我已将范围单元格添加到数组中。

Sub examp()
Dim rng As Range, cll As Range, i As Integer, a(100) As Variant
Set rng = Range(Range("A2:B2"), Range("A2:B2").End(xlDown)).SpecialCells(xlCellTypeVisible)
i = 0
For Each cll In rng
a(i) = cll.Value
i = i + 1
Next
End Sub

Answer 2

在代码中，您将 Variant 变量设置为等于 Range 对象，而不使用 Set 语句。

以下内容适用于我所做的小测试。当然，如果你将函数类型和其他变量声明为Range类型，也是可以的。

Option Explicit
Sub test()
Dim myVar As Variant

Set myVar = myList()

Debug.Print myVar.Address

End Sub

Public Function myList() As Variant
Dim myRng As Range

With Sheets("Sheet1")
    Set myRng = .Range(.Range("A1:B1"), .Range("A1:B1").End(xlDown)).SpecialCells(xlCellTypeVisible)
End With

Debug.Print myRng.Address

Set myList = myRng

End Function

Answer 3

我认为您的问题与

有关

.SpecialCells(xlCellTypeVisible)

当我这样做时：

Public Function ListeMaschinen() As Variant
  Dim  Auswahl As Range
  With Sheets("qry_TechnischesDatenblatt")
      Set Auswahl = .Range(.Range("A2:B2"),  .Range("A2:B2").End(xlDown)).SpecialCells(xlCellTypeVisible)
  End With
  MsgBox Auswahl.Address
  Set ListeMaschinen = Auswahl
  'Auswahl.Select
End Function

我得到一个由两部分组成的

Address

：可见部分！

但是当我删除

SpecialCells

Public Function ListeMaschinen() As Variant
  Dim Auswahl As Range
  With Sheets("qry_TechnischesDatenblatt")
      Set Auswahl = .Range(.Range("A2:B2"), .Range("A2:B2").End(xlDown))
  End With
  MsgBox Auswahl.Address
  Set ListeMaschinen = Auswahl
End Function

我得到了一个零件，这也是我使用

Select

时得到的。

我测试过！

Sub test()
  Dim myVar As Variant
  Dim i As Integer
  i = 0
  Set myVar = ListeMaschinen()
  For Each C In myVar
    i = i + 1
    MsgBox C.Value & C.Address & "-" & i
  Next
End Sub

Answer 4

除了我之前的评论之外，这里有一种方法，但会受到一些限制：

数据不能超过65536行；和 您不能有很长的文本（911 个字符以上），或空白的可见单元格；和 数据不应包含字符串“|~|”

如果满足这些条件，您可以使用如下内容：

Dim v
Dim sFormula              As String
With Selection
    sFormula = "IF(SUBTOTAL(103,OFFSET(" & .Cells(1).Address(0, 0) & ",row(" & .Address(0, 0) & ")-min(row(" & .Address(0, 0) & ")),1))," & .Address(0, 0) & ",""|~|"")"
End With
Debug.Print sFormula
v = Filter(Application.Transpose(Evaluate(sFormula)), "|~|", False)

您可以通过更改公式字符串中的替代文本来适应第三个限制。

Answer 5

你好:)我试图找到一种方法来循环遍历表中的可见行，而无需遍历所有行并检查它们是否可见，因为这在大表上消耗了太多时间。以下是我能想到的解决方案。它是一个返回给定范围内可见行的绝对行号数组的函数。

Function GetVisibleRows(LookupRange As Range) As Integer()
    Dim VisibleRange As Range, Index As Integer, Area As Range
    Static VisibleRows() As Integer    
    
    Set VisibleRange = LookupRange.SpecialCells(xlCellTypeVisible)
    ReDim VisibleRows(0)
    Index = 0
    
    For Each Area In VisibleRange.Areas
        If Index = 0 Then
            VisibleRows(Index) = Area.Row
            ReDim Preserve VisibleRows(Index + 1)
        End If
        
        Index = UBound(VisibleRows())
        
        If VisibleRows(Index - 1) <> Area.Row Then
            VisibleRows(Index) = Area.Row
            ReDim Preserve VisibleRows(Index + 1)
        End If
    Next
    
    ' Remove last empty item
    ReDim Preserve VisibleRows(UBound(VisibleRows()) - 1)
    GetVisibleRows = VisibleRows
End Function

如果您想在查找场景中使用此函数，您需要将函数返回的绝对行号转换为表的相对行号。以下对我有用。

RowIndex = ReturnedRowIndex - LookupRange.Rows(1).Row + 1 

祝你好运！

Answer 6

您的代码很有帮助。 我发现了一些可以改进的细节：

1. 使用长变量而不是整数将使代码适用于更大的范围。
2. 循环区域允许处理具有两个以上连续可见行的范围。

这是代码：“

Function GetGetVisibleRows(ByVal LookupRange As Range) As Long()

Dim VisibleRange As Range, Index As Long, Area As Range
Static VisibleRows() As Long
Dim lngJ As Long

Set VisibleRange = LookupRange.SpecialCells(xlCellTypeVisible)

ReDim VisibleRows(0)
Index = 0

For Each Area In VisibleRange.Areas

    For lngJ = 1 To Area.Rows.Count
    
        Index = Index + 1
        ReDim Preserve VisibleRows(Index)
        VisibleRows(Index) = Area.Cells(lngJ, 1).Row
        
    Next lngJ
Next Area

GetGetVisibleRows = VisibleRows

结束功能