PDA

توجه ! این یک نسخه آرشیو شده میباشد و در این حالت شما عکسی را مشاهده نمیکنید برای مشاهده کامل متن و عکسها بر روی لینک مقابل کلیک کنید : آموزشي: گزارش فیلتر در vba



Amir Ghasemiyan
2017/08/17, 19:47
سلام دوستان

همونطور که میدونین در اکسل قابلیتی داریم به نام فیلتر کردن. گاهی ممکنه پیش بیاد بخواین یک محدوده رو فیلتر کنین. خب حالا فرض کنید بیست تا ستون رو فیلتر کردین و هر ستون رو بر اساس یک آیتم فیلتر کردین. فهمیدن اینکه بر چه اساسی فیلترها اعمال شدن در این حالت کار راحتی نیست. این کد کمک میکنه شما بفهمین هر ستون بر چه اساس فیلتر شده و همچنین بدونین محدوده فیلتر شدتون کجاست.

این ظاهر این فایل هست اما اگر به کدها دقت کنید و یکم خلاق باشید میتونین متوجه بشید که چه کارهایی میشه با محدوده های فیلتر شده انجام داد مثلا اینکه بدونیم در یک ستون چند آیتم فیلتر شده و یا هر چیزی در مورد فیلتر ها



Sub ShowAutoFilterCriteria()
Dim oAF As AutoFilter, oFlt As Filter
Dim sField As String
Dim sCrit1 As String, sCrit2 As String
Dim sMsg As String, i As Integer


'Check if the sheet is filtered at all
If ActiveSheet.AutoFilterMode = False Then
MsgBox "The sheet does not have an AutoFilter"
Exit Sub
End If


'Get the sheet's AutoFilter object
Set oAF = ActiveSheet.AutoFilter


'Loop through the Filters of the AutoFilter
For i = 1 To oAF.Filters.Count


'Get the field name from the first row
'of the AutoFilter range
sField = oAF.Range.Cells(1, i).Value


'Get the Filter object
Set oFlt = oAF.Filters(i)


'If the filter is on...
If oFlt.On Then


'Get the standard filter criteria
sMsg = sMsg & vbCrLf & sField & oFlt.Criteria1


'If it's a special filter, show it
Select Case oFlt.Operator
Case xlAnd
sMsg = sMsg & " And " & sField & oFlt.Criteria2


Case xlOr
sMsg = sMsg & " Or " & sField & oFlt.Criteria2


Case xlBottom10Items
sMsg = sMsg & " (bottom 10 items)"


Case xlBottom10Percent
sMsg = sMsg & " (bottom 10%)"


Case xlTop10Items
sMsg = sMsg & " (top 10 items)"


Case xlTop10Percent
sMsg = sMsg & " (top 10%)"


End Select
End If
Next


If sMsg = "" Then
'No filters are applied, so say so
sMsg = "The range " & oAF.Range.Address & " is not filtered."
Else
'Filters are applied, so show them
sMsg = "The range " & oAF.Range.Address & " is filtered by:" & sMsg
End If


'Display the message
MsgBox sMsg
End Sub

sale1050
2019/04/25, 09:29
تاپیک خوبی بود
ساختمان پیش ساخته (https://bozorgmehr.co/%D8%B3%D8%A7%D8%AE%D8%AA%D9%85%D8%A7%D9%86-%D9%87%D8%A7%DB%8C-%D9%BE%DB%8C%D8%B4-%D8%B3%D8%A7%D8%AE%D8%AA%D9%87) کلبه چوبی (https://bozorgmehr.co/%D8%B3%D8%A7%D8%AE%D8%AA%D9%85%D8%A7%D9%86-%D9%87%D8%A7%DB%8C-%D9%BE%DB%8C%D8%B4-%D8%B3%D8%A7%D8%AE%D8%AA%D9%87/%D8%B3%D8%A7%D8%AE%D8%AA%D9%85%D8%A7%D9%86-%D9%BE%DB%8C%D8%B4-%D8%B3%D8%A7%D8%AE%D8%AA%D9%87-%DA%86%D9%88%D8%A8%DB%8C-%DA%A9%D9%84%D8%A8%D9%87-%DA%86%D9%88%D8%A8%DB%8C) خانه پیش ساخته (https://bozorgmehr.co/%D8%B3%D8%A7%D8%AE%D8%AA%D9%85%D8%A7%D9%86-%D9%87%D8%A7%DB%8C-%D9%BE%DB%8C%D8%B4-%D8%B3%D8%A7%D8%AE%D8%AA%D9%87/%D8%AE%D8%A7%D9%86%D9%87-%D9%BE%DB%8C%D8%B4-%D8%B3%D8%A7%D8%AE%D8%AA%D9%87) ساختمان پیش ساخته ورقی (https://bozorgmehr.co/%D8%B3%D8%A7%D8%AE%D8%AA%D9%85%D8%A7%D9%86-%D9%87%D8%A7%DB%8C-%D9%BE%DB%8C%D8%B4-%D8%B3%D8%A7%D8%AE%D8%AA%D9%87/%D8%B3%D8%A7%D8%AE%D8%AA%D9%85%D8%A7%D9%86-%D9%BE%DB%8C%D8%B4-%D8%B3%D8%A7%D8%AE%D8%AA%D9%87-%D9%88%D8%B1%D9%82%DB%8C) حمام پیش ساخته (https://bozorgmehr.co/%D8%B3%D8%A7%D8%AE%D8%AA%D9%85%D8%A7%D9%86-%D9%87%D8%A7%DB%8C-%D9%BE%DB%8C%D8%B4-%D8%B3%D8%A7%D8%AE%D8%AA%D9%87/%D8%AD%D9%85%D8%A7%D9%85-%D9%BE%DB%8C%D8%B4-%D8%B3%D8%A7%D8%AE%D8%AA%D9%87) سرویس بهداشتی پیش ساخته (https://bozorgmehr.co/%D8%B3%D8%A7%D8%AE%D8%AA%D9%85%D8%A7%D9%86-%D9%87%D8%A7%DB%8C-%D9%BE%DB%8C%D8%B4-%D8%B3%D8%A7%D8%AE%D8%AA%D9%87/%D8%B3%D8%B1%D9%88%DB%8C%D8%B3-%D8%A8%D9%87%D8%AF%D8%A7%D8%B4%D8%AA%DB%8C-%D9%BE%DB%8C%D8%B4-%D8%B3%D8%A7%D8%AE%D8%AA%D9%87)