Renkli hücrelerin ayrı ayrı listelenmesi

[pristineli45]

Hüseyin kardeş merhaba.
Söylediklerinize uyarak,yeni başlık adı altında sorumu soruyorum.
Sorularınıza sırayla yanıt vermek istiyorum:
1) 3000 sabit ama siz onu 4000 olarak yapın.
2) Ben renk kodu falan vermedim.Sizin yaptığınız renkler iyi.Hatta,tolerans dahilinde olan ölçüler açık maviye boyanıyor.Hiç boyanmasa bile olur.Önemli olan tolerans dışı değerlerin kırmızıya boyanması ve bunların ayrı ayrı listelenmesi.
Yani kırmızı hücrelerin bir tarafa,beyaz (ya da açık mavi) hücrelerin bir tarafa listelenmesi.
Şimdiden teşekkürler.

 

[Emir Hüseyin Çoban]

. . .

Kırmızı renk (255) kodunu baz alarak çalışır.

Sub KOD()
Application.ScreenUpdating = False
Dim S1 As Worksheet
Dim S2 As Worksheet
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")

S2.Range("A3:E65536").ClearContents


For i = 2 To 12 Step 2

For a = 8 To S1.[A65536].End(3).Row

If S1.Cells(a, i) <> 0 Or S1.Cells(a, i) <> "" Then

    If S1.Cells(a, i).Interior.Color = 255 Then

    S2son = S2.[D65536].End(3).Row + 1
    S2.Cells(S2son, "D") = S1.Cells(a, i - 1)
    S2.Cells(S2son, "E") = S1.Cells(a, i)

    Else

    S2son = S2.[A65536].End(3).Row + 1
    S2.Cells(S2son, "A") = S1.Cells(a, i - 1)
    S2.Cells(S2son, "B") = S1.Cells(a, i)

    End If

Else
End If

Next a
Next i

Application.ScreenUpdating = True
MsgBox " B i t t i "
End Sub

. . .

 

[pristineli45]

Hüseyin kardeş..
İlgine,bilgine,emeğine,en önemlisi YÜREĞİNE sağlık..
Harika.
Ufak bir düzeltme rica ediyorum.
Kod yazdığınız yerler kod değil,normal sıra no.
Dolayısıyla her ikisine de ayrı ayrı sıra no vermesi daha güzel olacak.

 

[Emir Hüseyin Çoban]

. . .

Sayfaların karşılaştırılmasında yerlerinin kolay bulunması için sıra numaralarını getirtmiştim.

Siz takip eden sıra no vermek için.
Aşağıdakı gibi revize edebilirsiniz.

S2.Cells(S2son, "D") = [B]S2son - 2[/B]
S2.Cells(S2son, "A") = [B]S2son - 2[/B]

. . .

 

[pristineli45]

Hüseyin kardeş.Ufak bir aksaklık çıkıyor. A sütunundaki tolerans içi ölçümlerinin sıra numaraları düzgün gidiyor. D sütunundaki tolerans dışı ölçümlerinin sıra numaralarında ise;
tolerans içi ile aynı sıraya kadar normal sayıyor,sonra sıranın sonuna kadar sayıları takip ediyor.

 

[Emir Hüseyin Çoban]

Hüseyin kardeş.Ufak bir aksaklık çıkıyor. A sütunundaki tolerans içi ölçümlerinin sıra numaraları düzgün gidiyor. D sütunundaki tolerans dışı ölçümlerinin sıra numaralarında ise;
tolerans içi ile aynı sıraya kadar normal sayıyor,sonra sıranın sonuna kadar sayıları takip ediyor.

. . .

Bu şekilde sonuç veren, tablonun örneğini ekleyiniz.

. . .

 

[pristineli45]

Hüseyin kardeş. Örneği ekledim. Çok vaktinizi ve emeğinizi aldım..Çok teşekkür ederim.

 

[Emir Hüseyin Çoban]

. . .

Düzeltmeyi yanlış yapmışsınız.

Şu şekilde olmalı.

    S2son = S2.[D65536].End(3).Row + 1
[B]    S2.Cells(S2son, "D") = S2son - 2[/B]
    S2.Cells(S2son, "E") = S1.Cells(a, i)

    Else

    S2son = S2.[A65536].End(3).Row + 1
[B]    S2.Cells(S2son, "A") = S2son - 2[/B]
    S2.Cells(S2son, "B") = S1.Cells(a, i)

. . .

 

[pristineli45]

Tamamdır Hüseyin kardeş.
Sorun düzeldi.Tekrar tekrar ve çok çok teşekkür ederim.