Filtrowanie tablic 2D w programie Excel VBA

Question

Korzystając z Excela i VBA, potrzebowałem porady, jak najlepiej filtrować dane w tablicy (w ten sam sposób, w jaki można użyć tabeli przestawnej), ściśle używając VBA. Tworzę UserForm, który będzie podejmował decyzje dotyczące danych w oparciu o aktualnie istniejące dane. Mogę sobie wyobrazić, jak to zrobić wystarczająco dobrze, ale nie jestem zorientowany w programowaniu VBA.

Oto przykład

A  B  C 
bob  12  Small 
sam  16  Large 
sally 1346 Large 
sam  13  Small 
sally 65  Medium 
bob  1  Medium 

Aby pobrać dane w tablicy, mogę używać

Dim my_array As Variant 

my_array = Range("A1").CurrentRegion 

Teraz jestem zaznajomiony z pętli przez tablice 2D, ale zastanawiałem się: co najefektywniejszy sposób filtrowania danych z tablicy 2D (bez powtarzania pętli przez macierz)?

Na przykład, w jaki sposób uzyskać byłoby powiedzieć dostać tego rodzaju danych:

data_for_sally As Variant 'rows with sally as name in ColA 
data_for_sally_less_than_ten As Variant ' all rows with sally's name in ColA and colB < 10 
data_for_all_mediums as Variant ' all rows where ColC is Medium 

sugestie? Mógłbym to załatwić przy pomocy kilku niestandardowych funkcji i pętli, ale myślałem, że musi być lepszy sposób. Dzięki.

Answer 1

Zakładam, że chcesz używać tylko VBA.

myślę, że to zależy od kilku parametrów, głównie na:

• jak często uruchamiać ten sam stan => pan zapisać wynik filtra czy też przeliczyć za każdym razem?
• jak często trzeba filtrować rzeczy => jeśli często, warto mieć odpowiednią strukturę kodu w miejscu, jeśli nie, to jednorazowa pętla jest wyraźnie drogą do zrobienia.

Z perspektywy OO, zakładając wydajność (szybkość & pamięci) nie jest problemem, chciałbym przejść do następnego projektu (nie będę wchodził w szczegóły wykonania, tylko daje ogólne pojęcie). Utwórz klasę (nazwijmy to pomysłowo ArrayFilter), której możesz użyć w ten sposób.

Ustawienia filtra

Dim filter As New ArrayFilter 
With filter 
    .name = "sam" 
    .category = "Medium" 
    .maxValue = 10 
End With 

Albo

filter.add(1, "sam") 'column 1 
filter.add(3, "Medium") 'column 3 
filter.addMax(2, 10) 'column 2 

Tworzenie przefiltrowane dane ustawione

filteredArray = getFilteredArray(originalArray, filter) 

getFilteredArray jest dość proste do upominawczym e: Chcesz pętli nad tablicy sprawdzenie, czy wartości dopasować filtr i umieścić ważne linie w nowej tablicy:

If filter.isValidLine(originalArray, lineNumber) Then 'append to new array 

Plusy

• czysty design
• wielokrotnego użytku, szczególnie z druga wersja, w której używasz numeru kolumny. Może to być użyte do filtrowania dowolnych tablic.
kod
• Filtrowanie jest w jednej funkcji, które można przetestować
• następstwem: uniknąć powielania kodu

Cons

• Filtering przeliczone za każdym razem, nawet jeśli ten sam filtr dwa razy. Możesz zapisać wyniki w Słowniku na przykład - patrz poniżej.
• Pamięć: każde wywołanie getFilteredArray tworzy nową tablicę, ale nie wiadomo, jak można tego w żaden sposób uniknąć.
• Dodaje to całkiem kilka linii kodu, więc zrobiłbym to tylko wtedy, gdyby to ułatwiło kod czytaj/zachowaj.

PS: Jeśli trzeba buforować wyniki w celu poprawy wydajności, jednym ze sposobów byłoby przechowywać wyniki w słowniku i dodać trochę logiki do funkcji getFilteredArray. Zauważ, że jeśli twoje tablice są naprawdę duże i/lub często używasz tego samego filtru, prawdopodobnie nie jest to tego warte.

filters.add filter, filteredArray 'filters is a dictionary 

W ten sposób, gdy dzwonisz getFilteredArray następnym razem, można zrobić coś takiego:

For each f in filters 
    'Check if all conditions in f and newFilter are the same 
    'If they are: 
    getFilteredArray = filters(f) 
    Exit Function 
Next 

'Not found in cache: compute the result 

Answer 2

Spróbuj

' credited to ndu 
Function Filter2DArray(ByVal sArray, ByVal ColIndex As Long, ByVal FindStr As String, ByVal HasTitle As Boolean) 
    Dim tmpArr, i As Long, j As Long, Arr, Dic, TmpStr, Tmp, Chk As Boolean, TmpVal As Double 
    On Error Resume Next 
    Set Dic = CreateObject("Scripting.Dictionary") 
    tmpArr = sArray 
    ColIndex = ColIndex + LBound(tmpArr, 2) - 1 
    Chk = (InStr("><=", Left(FindStr, 1)) > 0) 
    For i = LBound(tmpArr, 1) - HasTitle To UBound(tmpArr, 1) 
    If Chk Then 
     TmpVal = CDbl(tmpArr(i, ColIndex)) 
     If Evaluate(TmpVal & FindStr) Then Dic.Add i, "" 
    Else 
     If UCase(tmpArr(i, ColIndex)) Like UCase(FindStr) Then Dic.Add i, "" 
    End If 
    Next 
    If Dic.Count > 0 Then 
    Tmp = Dic.Keys 
    ReDim Arr(LBound(tmpArr, 1) To UBound(Tmp) + LBound(tmpArr, 1) - HasTitle, LBound(tmpArr, 2) To UBound(tmpArr, 2)) 
    For i = LBound(tmpArr, 1) - HasTitle To UBound(Tmp) + LBound(tmpArr, 1) - HasTitle 
     For j = LBound(tmpArr, 2) To UBound(tmpArr, 2) 
     Arr(i, j) = tmpArr(Tmp(i - LBound(tmpArr, 1) + HasTitle), j) 
     Next 
    Next 
    If HasTitle Then 
     For j = LBound(tmpArr, 2) To UBound(tmpArr, 2) 
     Arr(LBound(tmpArr, 1), j) = tmpArr(LBound(tmpArr, 1), j) 
     Next 
    End If 
    End If 
    Filter2DArray = Arr 
End Function