2016-11-29 7 views
1

に私は、Excel 2013のために、以下のsnippitを持っているVBAエクセルVBA Listrowアレイ

For Each r In rr 
If Not r.Range.Height = 0 Then 
    FNum = FNum + 1 
    ReDim Preserve testArr(1 To FNum, 1 To 23) 
    testArr(FNum) = r 
End If 

Next r 

私の目標は、アレイ内に濾過テーブルからすべての可視の行を取得することです。

表は任意の数の行にできますが、常に23列​​です。

高さが非表示の場合、高さがゼロになることがわかりました。しかし、私の人生のために、配列全体をどのように配列するかを理解することはできません。

R = listrow RR =

listrows YES、私はループREDIMを吸う知っています。

SpecialCells(xlCellTypeVisible)

doesntの作業のいずれかは、最初に隠さ行/列で停止するからです。

テーブル全体を配列にダンプして配列をフィルタリングするだけでも構いません。私はそれを適用するためにテーブルからアクティブなフィルタを引っ張る方法を理解していないhaventしかし、私はまだ深く見てhavent。私は今何をしているのだろう。なぜなら、私は他の方法で立ち往生しているからです。

すべてのアドバイスは大歓迎です。

DM

+1

rrとは何ですか?私はRedim Preserveが最後の次元のサイズを変更するだけなので、あなたのコードはあなたが望むように動作するとは思いません。 – SJR

+0

テーブルの大きさはどれくらいですか? –

答えて

0

おかげで、すべて、回答のコンボが私を導い:

Public Sub FilteredArray() 
    Dim Data As Variant, r As Range, Target As Range 
    Dim rowCount As Long, x As Long, y As Long 

    Set Target = WorkSheets("Sheet1").ListObjects("Table1").DataBodyRange.SpecialCells(xlCellTypeVisible) 

    If Not Target Is Nothing Then 
     rowCount = Target.Cells.Count/Target.Columns.Count 
     ReDim Data(1 To rowCount, 1 To Target.Columns.Count) 
     x = 1 
     For Each r In Target 
      y = y + 1 
      If y > Target.Columns.Count Then 
       x = x + 1 
       y = 1 
      End If 
      Data(x, y) = r.Value 
     Next 
    End If 

End Sub 
0

ことができますRR内のセルではなく、行をループ?もしそうなら、@SJRのように、最終寸法はRedim Preserveしかないので、寸法を変更する必要があります。 r.EntireRow.Hiddenを使用して、可視の行にあるかどうかを確認し、配列があればそれを1だけ増やすことができます。

以下は、あなたのデータが列Aで始まることを前提としています

For Each r In rr 
    If Not r.EntireRow.Hidden Then 
     If r.Column = 1 Then 
      If UBound(testArr, 2) = 0 Then 
       ReDim testArr(1 To 23, 1 To 1) 
      Else 
       ReDim Preserve testArr(1 To 23, 1 To UBound(testArr, 2) + 1) 
      End If 
     End If 
     testArr(r.Column, UBound(testArr, 2)) = r 
    End If 
Next r 

は編集:また

、あなたは、あなたの配列の境界を設定するために、一度、ListRowsを使用し続けるが、ループを通る二回することができますあなたがそう使用することができますREDIMまたはダブルループを回避するために

For Each r In rr 
    If Not r.Range.Height = 0 Then 
     Fnum = Fnum + 1 
     ReDim testArr(1 To Fnum, 1 To 3) 
    End If 
Next r 

Fnum = 0 
For Each r In rr 
    If Not r.Range.RowHeight = 0 Then 
     Fnum = Fnum + 1 
     dumarray = r.Range 
     For i = 1 To 3 
      testArr(Fnum, i) = dumarray(1, i) 
     Next i 
    End If 
Next r 
+0

配列がまだ割り当てられていない場合、 'UBound(testArr、2)= 0なら' Thenは型不一致エラーをスローします。 –

+0

お詫び申し上げます、はい、先ほど、「薄いtestArr(1から3、0から0)」と仮定していました。 – bobajob

2

:一回(行を介して実行するには、独自の内部ループを持っています...)の配列を埋めるためにApplication.WorksheetFunction.Subtotal(3, Range("A2:A500000"))のようなメーリングを使用して、表示可能な行の数をすばやくカウントします。

は私が.SpecialCells(xlCellTypeVisible)を使用して、私のTarget範囲を定義this question

1

を参照してください。 Target.Cells.Count/Target.Columns.Countはあなたに行数を与えます。最後に、Target.Columns.Countに基づいてカウンタをインクリメントするTargetの範囲のセルを繰り返します。

Function RowsToArray() 
    Dim lastRow: lastRow = ActiveWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 
    Dim lastCol: lastCol = ActiveWorkbook.ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column 
    Dim newArr() 
    ReDim newArr(lastRow) 
    For r = 0 To lastRow - 1 
     Dim rowarr() 
     ReDim rowarr(lastCol) 
     For c = 0 To lastCol - 1 
      rowarr(c) = Cells(r + 1, c + 1).Value 
     Next c 
     newArr(r) = rowarr 
    Next r 
End Function 
1

次のコードは、すべての行の配列を作成し、シート内のすべての情報を格納する別の配列にこれらのそれぞれを保存します〜:(あまりエレガントではないが速い)

For Each r In rr 
    If Not r.Range.Height = 0 Then 
     TNum = TNum + 1 
    End If 
Next r 

ReDim testArr(TNum, 23) 

For Each r In rr 
    If Not r.Range.Height = 0 Then 
     FNum = FNum + 1 
     For i = 1 To 23 
      testArr(FNum, i) = r.Range.Cells(, i) 
     Next i 
    End If 
Next r