Excel'de 2B Dizilerin Filtrelenmesi VBA

Question

Excel ve VBA'yı kullanarak, bir dizideki (yalnızca bir pivot tabloya benzer bir şekilde) verileri en iyi şekilde nasıl filtreleyeceğiniz konusunda biraz öneride bulunmak istedim. Şu anda var olan verilere dayanarak bazı veri kararları verecek olan bir UserForm oluşturuyorum. Bunu yeterince iyi yapabildiğimi hayal edebilirim, ancak VBA programcılığında bu kadar iyi değilim. İşte

bir Array verileri kapmak için bir örnek

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

, ben şimdi

Dim my_array As Variant 

my_array = Range("A1").CurrentRegion 

kullanabilirsiniz, ben 2D diziler arasında döngü aşina değilim, ama merak ettim: Ne 2B dizi verilerini filtrelemenin en etkili yolu (dizi zamanı boyunca tekrar ve tekrar olmadan)?

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 

Öneriler: bu tür verileri almak demek

Örneğin

, nasıl olacağını alabilirim? Bunu bir dizi özel işlev ve döngü ile halledebilirdim ama daha iyi bir yol olması gerektiğini düşündüm. Teşekkürler.

Answer 1

Sadece VBA kullanmak istediğinizi varsayalım. Aynı durumun çalışma sıklığını

• => Bir filtrenin sonucunu depolayan veya her defasında yeniden hesaplamak yapın:

  Ben esas üzerinde, çeşitli parametrelere bağlı olduğunu düşünüyorum?

• ne sıklıkta bir şeyleri filtrelemeniz gerekiyor? => Eğer sık ​​sık, eğer uygun bir kod yapısına sahip olmak gerekiyorsa, o zaman eğer bir kapalı devre kesinlikle gidilecek bir yol değildir. Bir OO açısından bakıldığında

, varsayarak performansı (hız & bellek) I (Ben sadece genel bir fikir vermek, uygulama detaylarına girmeyeceğim) Aşağıdaki tasarım için gider, bir sorun değildir. Bu şekilde kullanabileceğiniz bir sınıf oluşturun (hayal edelim ArrayFilter diyelim).

Kur filtresi

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

Ya

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

oluştur süzülmüş veri getFilteredArray iradesine karşı oldukça basittir

filteredArray = getFilteredArray(originalArray, filter) 

set E: Özellikle birlikte,

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

Artıları

• Temiz tasarım
• Yeniden kullanılabilir: Değerler filtreyle eşleşen ve yeni bir dizide geçerli çizgiler koymak olmadığını kontrol dizinin üzerinde size döngü Sütun numarasını kullandığınız ikinci sürüm. Bu, herhangi bir diziyi gerçekten filtrelemek için kullanılabilir.
• Filtreleme kodu
• doğal sonucu test edebilirsiniz bir işlevi şudur: Aynı filtre kullanmak bile Filtreleme yeniden hesaplandığı her defasında kod

Eksileri

• tekrarını önlemek iki defa. Sonuçları bir Sözlük içinde saklayabilirsiniz, örneğin aşağıya bakın.
• Bellek: getFilteredArray öğesine yapılan her çağrı yeni bir dizi oluşturur, ancak bunun nasıl önlenebileceğinden emin değilsiniz.
• Bu, birkaç satırlık kod eklediğinden, yalnızca kodun daha kolay yapılmasını sağlarsa bunu yapardım. oku/koru.

ps: performansı artırmak için sonuçları önbelleğe almak gerekiyorsa, tek yönlü bir sözlükte sonuçlarını saklamak ve getFilteredArray işlevine bazı mantık eklemek olacaktır. Dizileriniz gerçekten büyük olmadıkça ve/veya aynı filtreyi çok fazla çalıştırmıyorsanız, muhtemelen buna değmeyeceğini unutmayın. Eğer getFilteredArray dahaki sefere çağırdığınızda

filters.add filter, filteredArray 'filters is a dictionary 

Bu şekilde, böyle bir şey yapabilirsiniz:

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

bu

' 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