Question

我的数据集包含标题＆＃39;商品ID＆＃39;商品编号＆＃39;，＆＃39;商品描述＆＃39;，＆＃39;授权＆＃39;和＆＃39;包括＆＃39;。

我需要编写一段VBA代码，用于过滤数据，存储过滤行的行索引，计算通过过滤器的项目数，并将过滤后的数据存储到临时数组/变量/矩阵中（在本地窗口中，无论它在VBA中）。

例如，如果我按项目描述过滤这40行等于F ..

Item ID Item Number Item Description Authorized Included
91099   96  O   416 359
1147    21  K   576 393
86077   26  J   50  883
3738    21  F   131 671
88084   74  T   921 535
68014   100 H   303 680
70440   19  B   435 293
25844   65  V   64  285
77342   79  Y   315 346
61486   23  X   380 488
37582   30  S   585 807
27215   81  D   635 877
58618   58  E   531 200
30313   95  T   154 870
2240    76  F   363 818
63700   100 G   514 67
7046    60  R   752 907
67399   21  D   86  89
62552   23  V   616 68
77686   12  B   628 889
50082   69  J   539 429
434 73  U   942 258
62964   49  Y   422 849
11982   16  H   367 97
751 95  K   250 373
50195   31  I   663 376
81141   9   M   291 359
30809   48  N   556 190
84080   20  H   897 960
84039   77  J   899 77
62669   49  K   966 221
1664    43  L   800 353
70525   29  O   475 657
93961   3   W   423 413
7562    98  S   440 952
48109   66  X   122 69
45892   26  C   681 121
33574   90  D   476 58
62539   24  Q   761 795
64962   21  R   623 375

我得到2行通过过滤器

Item ID Item Number Item Description Authorized Included
3738    21  F   131 671
2240    76  F   363 818

我希望在本地存储2行，但也需要具有相应行索引（5和16）的数组。

Answer 1

这是你想要达到的目标吗？我的代码肯定没有优化，但它说明了如何使用ListObject过滤单元格并将结果保存在数组中：

Sub FilterRange()

    Dim lo As ListObject

    'create list object (table)
    Set lo = Sheet1.ListObjects.Add(SourceType:=xlSrcRange, Source:=Range("A1:E41"), XlListObjectHasHeaders:=xlYes)
    lo.Name = "myTable"

    'apply filter (could not get field parameter to work with named column)
    lo.Range.AutoFilter field:=3, Criteria1:="F", Operator:=xlAnd

    'assign range to array
    Dim aResults() As Variant
    Dim iCols, iRows As Integer
    iCols = Range("A1:E41").SpecialCells(xlCellTypeVisible).Columns.Count
    iRows = Range("A1:E41").SpecialCells(xlCellTypeVisible).Areas.Count

    'dim array - add an extra column for row id
    ReDim aResults(iRows, iCols + 1)

    Dim i, j As Integer
    Dim c As Variant

    'Iterate through filtered areas copying values into array - change to
    '      Range("A1:E41").Offset(1,0).SpecialCells(xlCellTypeVisible).Areas
    '      to skip the header row.
    i = 0
    For Each area In Range("A1:E41").SpecialCells(xlCellTypeVisible).Areas
        j = 1
        For Each c In area
            aResults(i, 0) = c.Row      'row number
            aResults(i, j) = c.Value
            j = j + 1
        Next c
        i = i + 1
    Next area

   'print
   ' For i = 0 To UBound(aResults, 1) - 1
   '     For j = 0 To UBound(aResults, 2) - 1
   '         Debug.Print aResults(i, j)
   '     Next j
   ' Next i
End Sub

使用以下内容清除过滤器：

Sub UnfilterRange()
    'turn table back to range

    'if no tables, then ignore and continue
    On Error Resume Next
    Sheet1.ListObjects("myTable").Unlist

End Sub

VBA Excel对过滤后的数据执行操作

1 个答案: