Динамический Вложенный Для Петель - PullRequest
0 голосов
/ 25 августа 2011

Прежде всего, я прошу прощения за начало нового потока, но оригинал запутался, потому что я не мог четко сформулировать свой запрос (Ссылка на оригинальный поток: Динамические вложенные циклы для автофильтра в Excel VBA ).Но теперь я фактически написал программу так, как мне нравится, за исключением использования оператора switch вместо более динамичного использования вложенных циклов.

edit:
RSum используется для хранения диапазона и логического значения.Пользователь выбирает ячейку заголовка для столбца и выбирает, хотят ли они получить суммирование этого столбца или уникальный счет при суммировании.Это позволяет собирать эти объекты для суммирования нескольких столбцов.Этот вклад не так уж плох, чтобы сделать динамичным.Следующий вход, который начинается как rtemp и заканчивается как array1, снова выбирает ячейку заголовка для столбца, но при этом он принимает значения в этом столбце и сохраняет уникальный список в array1.С этим списком цикл for проходит по массиву, используя его значение в качестве критерия для автофильтра.Для каждого шага в цикле после автофильтрации сводка рассчитывается с использованием SumThisA, принимающего в качестве входных данных коллекцию объектов RSum.Данные располагаются в столбцах, где каждая строка является уникальной записью.

Таким образом, вопрос для приведенного ниже кода: я хочу, чтобы пользователь мог выбрать количество категорий для суммирования, иметьвсплывающее окно, чтобы заполнить эти диапазоны (можно выяснить это), а затем запустить фильтр следующим образом:

for i = 0 to UBound(array1)
    Autofilter criteria1:=array1(i)
    for j = 0 to UBound(array2)
        Autofilter criteria1:=array2(j)
        ......
            for x = 0 to UBound(arrayx)
                Autofilter criteria1:=arrayx(x)
                aSum(i,j,....x) = somefunction

Теперь я понимаю, что мне нужно было бы использовать рекурсивную функцию, но я никогда раньше ее не использовал иНесколько сложность этой программы, это вне моего понимания.Кто-нибудь сможет помочь объяснить, как использовать его в этом контексте?Плюс из-за обобщения этой программы, это может быть полезным инструментом для многих людей.

'---------Initialize Arrays---------------'
t = sMax - 1
Dim aSum()
ReDim aSum(UBound(arr1), t)  

'---------------------Perform Summary----------------'
For i = LBound(arr1) To UBound(arr1)
If i = 0 Then
    Data.AutoFilter field:=afield, Criteria1:=arr1, Operator:=xlFilterValues
Else
    Data.AutoFilter field:=afield, Criteria1:=arr1(i)
End If
temp = SumThisA(SumValues, sMax)
    For j = LBound(temp) To UBound(temp)
        aSum(i, j) = temp(j)
    Next j
Next i  

Сумма в долларах для:
1. arrayA (1) ------- 100
- arrayB (1) ------ 30
-массив B (2) ------ 70
2. массив A (2) ------- 200
- массив B (1) ----- 120
- массив B (2)------ 80
3. Итого ----------- 300

Ответы [ 2 ]

1 голос
/ 26 августа 2011

Вот очень клёвый пример рекурсии для того, что, кажется, вы хотите сделать.Я подделал некоторые критерии, так что не зацикливайтесь на том, как я проверяю это, важно то, как рекурсивно функционирует функция Filter.Если бы я мог более точно определить, что вы хотели, я мог бы создать его более точно и с меньшим количеством жесткого кодирования.

Test Harness:

Public Sub Test()

Dim FilteredArray As Variant, cArray As Variant, working Array As Variant
Dim criteria As Integer

criteria = 1
ReDim criteriaArray(1 To 2)
cArray(1) = Range("C1").Value
cArray(2) = Range("C2").Value
Set workingArray = Range("A1:A7")
FilteredArray = Filter(workingArray, 7, cArray, criteria)    
Range("D1") = FilteredArray    

End Sub

Функция рекурсивного фильтра:

Public Function Filter(workingArray As Variant, index As Integer, _
                       criteriaArray As Variant, criteria) As Variant

Dim tempArray As Variant, i As Integer

ReDim tempArray(1 To 1)
For i = 1 To index
  If Mid(workingArray(i), criteria, 1) = criteriaArray(criteria) Then
    ReDim Preserve tempArray(1 To UBound(tempArray) + 1)
    tempArray(UBound(tempArray) - 1) = workingArray(i)
  End If
Next i
ReDim Preserve tempArray(1 To UBound(tempArray) - 1)

If criteria < 2 Then
  Filter = Filter(tempArray, UBound(tempArray), criteriaArray, criteria + 1)
Else
  Filter = tempArray
End If

End Function
0 голосов
/ 27 августа 2011

Рассматривали ли вы использование сводной таблицы? Ваши требования кажутся очень близкими к этой функциональности ...

...