开发者

Dynamic Nested For Loops

First off, I apologize for starting a new thread but the original got confusing because I couldn't articulate my ask well (Link to original thread: Dynamic Nested Loops for Autofilter in Excel VBA). But now I have actually written the program to the way I like except using a switch statement instead of the more dynamic use of nested looping.

edit:

RSum is used to store a range and a boolean. The user selects the header cell for a column and chooses whether they want get a summation of that column or a unique count when summarizing. This allows for a collection of these objects to allow summarizing of multiple columns. This input wasn't so bad to make dynamic. The next input which starts as rtemp and ends as array1, is again the user selects the header cell for a column but this it takes the values in that column and saves a unique list to array1. With this list a for loop loops through the array using its value as criteria for an autofilter. For each step in the loop after the autofilter, the summary is calculated using the SumThisA taking the RSum object collection as an input. The data is laid out in columns where each row is a unique record.

So the question is, for the below code, I want the user to be able to select the number of categories to summarize by, have a popup to fill in those ranges (can figure thi开发者_如何学Gos out), and then run a filter as such:

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

Now I understand I would need to use a recursive function, but having never used one before and the somewhat complexity of this program, it is out of my understanding. Would anyone be able to help explain how to use it in this context? Plus because of the generalization of this program, it could be a useful tool for many people.

'---------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  

Sum of Dollars For:

1. arrayA(1)-------100

- arrayB(1)------30

- arrayB(2)------70

2. arrayA(2)-------200

- arrayB(1)-----120

- arrayB(2)------80

3. Total-----------300


Here's a very kludgy example of recursion for what it seems you want to do. I faked up some criteria, so don't get hung up on how I'm testing for that, what's important is how the function Filter functions recursively. If I could pinpoint more exactly what you wanted I could craft it more precisely, and with less hardcoding.

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

Recursive Filter Function:

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


Have you considered using a pivot table ? Your requirements seem very close to that functionality...

0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜