0

おはようございます。17 個のフィールドといくつかの行 (10 ～ 20 行) を持つ listobject があり、列で見つけた個別の値について listobject をフィルター処理する必要があります。このフィルタリングされたリストオブジェクトは、別の整数列で昇順に並べ替える必要があり、次に、連続していないデータを見つけて、連続した数値の最小値と最大値を取得する必要があります。

一意の値を取得するために、うまく機能するこの関数を作成しました。

    Public Function GetUnique(Inputrange As Range)

    Dim d As Object, c As Range, k, tmp As String

    Set d = CreateObject("scripting.dictionary")
    For Each c In Inputrange
        tmp = Trim(c.Value)
        If Len(tmp) > 0 Then d(tmp) = d(tmp) + 1
    Next c
    GetUnique = d.Keys
End Function

データをフィルタリングし、フィルタリングされたデータを並べ替えるには、このコードを使用しようとしています

Dim tblaux as listobject
Dim RdS as variant
Dim r as variant

With tblaux
        Z = GetUnique(.ListColumns(7).DataBodyRange)
        For Each RdS In Z
            .Range.AutoFilter Field:=7, Criteria1:="=" & RdS
            .Sort.SortFields.Clear
            .Sort.SortFields.Add Key:=.Range.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With .Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                 Set r = .rng.Offset(1, 0).Resize(.rng.Rows.Count - 1, .rng.Columns.Count).SpecialCells(xlCellTypeVisible)
            End With
    Next RdS
End with

このコードから得られるのは、フィルタリングおよびソートされたデータを含む配列である必要がありますが、得られるのは、テーブル内の連続していない行に対応する多数の領域で作成されます。

私は少し怒っていますが、この問題を解決することはできません。

ご支援ありがとうございます

4

1 に答える 1

0

OPの明確化の後に編集され、彼は連続した範囲をフィルタリングしたかった

Option Explicit

Sub main()
    Dim tblaux As ListObject
    Dim RdS As Variant, Z As Variant
    Dim r As Variant

    With Worksheets("tblaux").ListObjects("tblaux")
        Z = GetUnique(.ListColumns(7).DataBodyRange)
        With .Range
            For Each RdS In Z
                .Sort key1:=.Range("G1"), order1:=xlAscending, key2:=.Range("A1"), order2:=xlAscending, Header:=xlYes, Orientation:=xlTopToBottom, MatchCase:=False
                .AutoFilter Field:=7, Criteria1:="=" & RdS
                MsgBox .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible).Address
                r = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible).Value
            Next RdS
        End With
    End With
End Sub
于 2016-10-03T11:24:33.430 に答える