Excel vba范围只有可见的单元格到数组

Question

我试图将一个范围内的可见单元格中的所有值都放入一个数组中。 我的代码只使数组携带值直到第一个不可见的Cell然后停止。

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

您好:)我试图找到一种方法来遍历表中的可见行，而不遍历所有行并检查它们是否可见，因为这在大型表上消耗了太多时间。以下是我想出的解决方案。该函数返回给定Range中可见行的绝对行数的数组。

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 

祝你好运！