將范圍的可見單元格添加到數組

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

在您的代碼中，您在不使用 Set 語句的情況下將 Variant 變量設置為等於 Range 對象。

以下適用於我所做的小測試。 當然，如果你將函數類型和其他變量聲明為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 

祝你好運！