Here, I prefer
to transfer the data to an array so that I can use them in other calculation.
The key commend
I used here is that If Rng(i,1).Rows.Hidden = False Then
Copy the data into the destination array which is transferred into the main sub
later.
Sub main()
Dim FiltResult() As Variant
Dim Filtersheet As Worksheet
Dim FiltRange As Range
Dim FiltField As Integer
Dim FiltCrit As Variant
Set Filtersheet =
sheets("Sheet1")
Set FiltRange =
Filtersheet.Range("C6:F7380")
FiltField = 1
FiltCrit = 910
FiltResult =
Copyfilter(Filtersheet, FiltRange, FiltField, FiltCrit)
'''''
''''Codes related with the filtered result
''''
End Sub
Function Copyfilter(Sht As Worksheet, Rng As Range, FField As Integer,
Crit As Variant)
Dim Arr() As Variant
Sht.Select
With Sht
'Remove any
existing filters
Rng.AutoFilter
RowCount =
Rng.Rows.Count
ColCount =
Rng.Columns.Count
Count = 1
ReDim Arr(1 To
RowCount, 1 To ColCount)
Rng.AutoFilter
Field:=FField, Criteria1:=Crit
'------Copy the
data to array for future use
For i = 2 To RowCount
If Rng(i,
1).Rows.Hidden = False Then
For j = 1 To
ColCount
Arr(Count, j) =
Rng(i, j).Value
Next j
Count = Count +
1
End If
Next i
'Remove the filter
Rng.AutoFilter
End With
'----Transfer the
data to the main sub
Copyfilter = Arr
End Function
No comments:
Post a Comment