مخفی کردن سطرها در اکسل بر اساس رنگ سلول

با سلام خدمت کاربران عزیز آی تی سواد

در فایل اکسل لیستی از سلول های دارای رنگ های مختلفی دارم .اکنون من باید تمام ردیف های با رنگ آبی روشن را مانند تصویر زیر مخفی کنم.

چگونه می توانیم به سرعت و به راحتی این کار در اکسل انجام دهیم؟

مخفی کردن سطرها در اکسل بر اساس رنگ سلول با کد VBA

۱. کلیدهای Alt + F11 را فشار دهید تا پنجره Microsoft Visual Basic for Applications باز شود .

۲. در پنجره Microsoft Visual Basic for Applications بر رویInsert > Module کلیک کنید و سپس از زیر کد VBA را کپی و در درون پنجره ماژول قراردهید .

Sub Hidebycolor()
'Updateby Extendoffice 21060725
    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    Dim I As Long
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.Columns(1).AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.Columns(1).AddressLocal
    End If
LInput:
    Set xRg = Application.InputBox("Range:", "itsavad.ir", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    If xRg.Areas.Count > 1 Then
        MsgBox "does not support multiple selections", vbInformation, "itsavad.ir"
        GoTo LInput
    End If
    If xRg.Columns.Count > 1 Then
        MsgBox "the selection is not more than 1 column", vbInformation, "itsavad.ir"
        GoTo LInput
    End If
    On Error Resume Next
    Application.ScreenUpdating = False
    For I = 1 To xRg.Count
        If xRg.Range("A" & I).Interior.ColorIndex = 20 Then
            xRg.Range("A" & I).EntireRow.Hidden = True
        End If
    Next 'i
    Application.ScreenUpdating = True
End Sub

Sub Hidebycolor()

'Updateby Extendoffice 21060725

Dim xRg As Range

Dim xTxt As String

Dim xCell As Range

Dim I As Long

On Error Resume Next

If ActiveWindow.RangeSelection.Count > 1 Then

xTxt = ActiveWindow.RangeSelection.Columns(1).AddressLocal

Else

xTxt = ActiveSheet.UsedRange.Columns(1).AddressLocal

End If

LInput:

Set xRg = Application.InputBox("Range:", "itsavad.ir", xTxt, , , , , 8)

If xRg Is Nothing Then Exit Sub

If xRg.Areas.Count > 1 Then

MsgBox "does not support multiple selections", vbInformation, "itsavad.ir"

GoTo LInput

End If

If xRg.Columns.Count > 1 Then

MsgBox "the selection is not more than 1 column", vbInformation, "itsavad.ir"

GoTo LInput

End If

On Error Resume Next

Application.ScreenUpdating = False

For I = 1 To xRg.Count

If xRg.Range("A" & I).Interior.ColorIndex = 20 Then

xRg.Range("A" & I).EntireRow.Hidden = True

End If

Next 'i

Application.ScreenUpdating = True

End Sub

۳. سپس کلید F۵ را فشار دهید تا آن را اجرا کنید، و یک پنجره نمایش داده می شود که می خواهد ستون مورد نظرتان را انتخاب کنید .

۴. سپس روی ok کلیک کرده، همه سلول ها با رنگ آبی روشن پنهان می شوند.

نکات:

عدد ۲۰ در کد If xRg.Range(“A” & I).Interior.ColorIndex = 20 کد رنگ آبی روشن می باشد ، می توانید آنرا بر اساس نیازتان تغییر دهید.
برای پیدا کردن کد رنگ مورد نظر از کد زیر استفاده کنید

Function GetColor(r As Range) As Integer
GetColor = r.Interior.ColorIndex
End Function

Function GetColor(r As Range) As Integer

GetColor = r.Interior.ColorIndex

End Function

سپس فرمول (GetColor(A2= را وارد کنید تا کد رنگ موردنظر را بدست آورید.

ترجمه شده از سایت www.extendoffice.com

ممنون از همراهی شما کاربران عزیز آی تی سواد

اشتراک گذاری

بیشتر

با سلام خدمت کاربران عزیز آی تی سواد

مخفی کردن سطرها در اکسل بر اساس رنگ سلول با کد VBA

نکات:

ممنون از همراهی شما کاربران عزیز آی تی سواد

دیدگاهتان را بنویسید لغو پاسخ