ماکروی فیلتر رنگ خاص در صورت وجود رنگ خاص در Table !

[Skynet]

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

من و سیزده بدر و اکسل و ماکرو یهویی و تلاش بی پایان...

آرزوی اوقاتی خوش برای همه عزیزان

برای انجام خواسته ای نیاز به همفکری و یاری اساتید عزیز دارم.
به کدی نیاز دارم که اگر ستون مورد نظر رنگ خاصی وجود داشت فیلتر کنه در غیر اینصورت کاری نکنه !
طی بررسی هایی که داشتم به کدی رسیدم اگر تازه اشتباه نباشه! ، ولی نمی دونم اون قسمت اول که باید بگم " اگر این رنگ وجود داشت " ، رو چطور تعریف کنم ! لطفا در صورت امکان راهنمایی بفرمائید خیلی ممنونم.

Sub Macro1()'
 
If ---- Then


    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=3, Criteria1:=RGB _
        (22, 54, 92), Operator:=xlFilterCellColor


End If
 
End Sub

اخطار: این یک موضوع قدیمی است به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.

[iranweld]

با سلام

از کد ذیل استفاده کنید

sub test()

z1 = Sheet1.Cells(Sheet1.Rows.Count, "C").End(xlUp).Row

For I = 2 To z1

If Range("C" & I).Interior.ColorIndex = 49 Then

    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=3, Criteria1:=RGB _
        (22, 54, 92), Operator:=xlFilterCellColor
        
 Exit For

End If

Next I
 

End Sub 

[Skynet]

با سلام

از کد ذیل استفاده کنید

sub test()

z1 = Sheet1.Cells(Sheet1.Rows.Count, "C").End(xlUp).Row

For I = 2 To z1

If Range("C" & I).Interior.ColorIndex = 49 Then

    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=3, Criteria1:=RGB _
        (22, 54, 92), Operator:=xlFilterCellColor
        
 Exit For

End If

Next I
 

End Sub 

با سلام و احترام
خیلی خیلی ممنونم از لطفتون عالی بود .
فقط یک نکته ! این پست در راستای حل یک مشکلی هست که خودتون زحمت کشیدید حل کردید ، در پست زیر :
http://forum.exceliran.com/showthrea...6184#post56184

فقط من الان نمی دونم چطور میشه این دو کد رو با هم ترکیب کنم ! که با زدن کلید، ماکرو به هر دو جدول مراجعه کنه و تشخیص بده اگر رنگ مورد نظر وجود داشت سطر ها رو فیلتر کنه و عملیات انتقال رو انجام بده !
الان هم کد انتقال موجوده و هم کد فیلتر رنگ ، که هر دو رو هم خودتون لطف کردید حل کردید، بی نهایت ممنونم.البته من بدلیل نیازم یک تغییر کوچک در کد دادم.

کد انتقال اطلاعات فیلتر شده از هر دو جدول A و B به جدول HOME :

Sub transfer()

za = Sheets("A").Cells(Sheets("A").Rows.Count, "B").End(xlUp).Row


For I = 2 To za


If Sheets("A").Rows(I & ":" & I).EntireRow.Hidden = False Then


z2 = Sheets("Home").Cells(Sheets("Home").Rows.Count, "B").End(xlUp).Row + 1


Sheets("A").Range("B" & I & ":j" & I).Copy Destination:=Sheets("Home").Range("B" & z2)
Sheets("Home").Range("K" & z2) = 1


End If


Next




zb = Sheets("B").Cells(Sheets("B").Rows.Count, "B").End(xlUp).Row


For I = 2 To zb


If Sheets("B").Rows(I & ":" & I).EntireRow.Hidden = False Then


z2 = Sheets("Home").Cells(Sheets("Home").Rows.Count, "B").End(xlUp).Row + 1


Sheets("B").Range("B" & I & ":B" & I).Copy Destination:=Sheets("Home").Range("c" & z2)
Sheets("B").Range("D" & I & ":G" & I).Copy Destination:=Sheets("Home").Range("G" & z2)
Sheets("Home").Range("K" & z2) = 2


End If


Next


End Sub

کد فیلتر رنگ در جدول A :

Sub FilterBlueRow()

za1 = Sheet2.Cells(Sheet2.Rows.Count, "C").End(xlUp).Row




For I = 2 To za1


If Range("C" & I).Interior.ColorIndex = 49 Then


    ActiveSheet.ListObjects("Table269").Range.AutoFilter Field:=3, Criteria1:=RGB _
        (22, 54, 92), Operator:=xlFilterCellColor
        
 Exit For


End If


Next I
 


End Sub

نکته : من رنگ آبی رو بوسیله شرطی در این فایل ایجاد می کنم ! و این کد نمی تونه اونو بشناسه ! مگه اینکه رو اکسلی که شما درست کردید ، رو سلول آبی رنگش Format Painter رو بزنم بیام رو جدول خودم رو یکی از سلول های آبی اعمال کنم که کد بتونه تمام سلول آبی های آبی رو تشخیص بده ! در غیر اینصورت نمی تونه ! برای رفع این مشکل چه کاری میشه کرد؟!

کد فیلتر رنگ سبز در جدول B :
از اونجایی که نمی دونستم عدد 49 برای رنگ آبی رو چطور بدست آوردید نتونستم عدد متناظر رنگ سبز رو بدست بیارم !

و در اخر اینکه : من واقعا از شما ممنونم بخاطر تمام کمک هایی که می کنید فقط می تونم بگم خدا خیرتون بده ان شالله فرصتی برای جبران پیش بیاد تا بتونم زحمات شما رو جبران کنم و از اینکه هر چقدر میریم جلوتر و شرایط کمی سخت تر میشه عذر خواهی می کنم ، اگر براتون مقدور بود خیلی خیلی ممنونم میشم راهنمایی کنید. مرسی.

[Skynet]

با سلام جناب
در تحقیقاتی که درباره کد رنگ داشتم در این لینک :
https://msdn.microsoft.com/en-us/lib...ffice.12).aspx

به این نتیجه رسیدم که چون من سلول رو رنگ آمیزی نکردم و از Conditional Formating برای رنگ آمیزی سلول های مدنظرم استفاده کردم ! احتمالا بایستی به جای :

.Interior.ColorIndex = 49

از آیتم : FormatColor Object برای شناسایی سلول های رنگی مد نظر استفاده کرد ! فقط هر چقدر سعی کردم متوجه نشدم به چه صورتی باید این کار رو بکنم !



لطفا در صورت امکان ، در این خصوص و مورد قبلی مطرح شده راهنمایی بفرمایید ، خیلی خیلی ممنونم از شما.

[Skynet]

با سلام خدمت عزیزان بویژه استاد عزیز Iranweld
به لطف خدا و تلاش بی وقفه هرطور بود مشکل رو حل کردم خیلی ممنونم از راهنمایی های عالیتون ، مطمعنا" بدون کمک شما ، حل مسله نیازمند تلاش خیلی بیشتری می بود.
با تشکر

Sub transfer()

Sheets("A").Select
    Range("C2").Select
    Selection.End(xlDown).Select
    Selection.ListObject.ListRows.Add AlwaysInsert:=True
   Selection.End(xlDown).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With

za1 = Sheet2.Cells(Sheet2.Rows.Count, "C").End(xlUp).Row
For I = 2 To za1
If Range("C" & I).Interior.ColorIndex = 49 Then
    ActiveSheet.ListObjects("Table269").Range.AutoFilter Field:=3, Criteria1:=RGB _
        (22, 54, 92), Operator:=xlFilterCellColor     
 Exit For
End If
Next I
 
     Range("C2").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.EntireRow.Delete

Sheets("B").Select
    Range("B2").Select
    Selection.End(xlDown).Select
    Selection.ListObject.ListRows.Add AlwaysInsert:=True
   Selection.End(xlDown).Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

za1 = Sheet3.Cells(Sheet3.Rows.Count, "B").End(xlUp).Row
For I = 2 To za1
If Range("B" & I).Interior.ColorIndex = 3 Then
    ActiveSheet.ListObjects("Table6").Range.AutoFilter Field:=2, Criteria1:=RGB _
        (255, 0, 0), Operator:=xlFilterCellColor      
 Exit For
End If
Next I
 

     Range("B2").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.EntireRow.Delete


Sheets("HOME").Select
za = Sheets("A").Cells(Sheets("A").Rows.Count, "B").End(xlUp).Row
For I = 2 To za
If Sheets("A").Rows(I & ":" & I).EntireRow.Hidden = False Then
z2 = Sheets("Home").Cells(Sheets("Home").Rows.Count, "B").End(xlUp).Row + 1
Sheets("A").Range("B" & I & ":j" & I).Copy Destination:=Sheets("Home").Range("B" & z2)
Sheets("Home").Range("K" & z2) = 1
End If
Next

zb = Sheets("B").Cells(Sheets("B").Rows.Count, "B").End(xlUp).Row
For I = 2 To zb
If Sheets("B").Rows(I & ":" & I).EntireRow.Hidden = False Then
z2 = Sheets("Home").Cells(Sheets("Home").Rows.Count, "B").End(xlUp).Row + 1
Sheets("B").Range("B" & I & ":B" & I).Copy Destination:=Sheets("Home").Range("c" & z2)
Sheets("B").Range("D" & I & ":G" & I).Copy Destination:=Sheets("Home").Range("G" & z2)
Sheets("Home").Range("K" & z2) = 2
End If
Next

Sheets("A").Select
    Range("A3").Select
    ActiveSheet.ShowAllData
Sheets("B").Select
    Range("A3").Select
    ActiveSheet.ShowAllData
    Sheets("HOME").Select
    Range("A3").Select
End Sub