farklı bir FOR - NEXT döngüsü

[Tevfik_Kursun]

Merhaba Arkadaşlar,
Bu örnekte S:AB sütunları arasında boyalı olan hücreleri AN:AR arasında aynı hizadaki hücrelere "X" harfi koyacağız.
Önemli olan T sütununda dolgu olan hücrelerin hizasında AN sütununda "X" harfi
V sütununda dolgu olan hücrelerin hizasında AO sütununda "X" harfi
X sütununda dolgu olan hücrelerin hizasında AP sütununda "X" harfi
Z sütununda dolgu olan hücrelerin hizasında AQ sütununda "X" harfi
AB sütununda dolgu olan hücrelerin hizasında AR sütununda "X" harfi koyacağız.
Bunu manuel olarak 30 aralık oluşturup yaptım.
FOR NEXT döngüsü içinde yapılır mı? sorusu geldiğinde, ortaya çıkan iki değişkenden biri 1 - 31 arasında dönüyor, diğeri 2 atlayarak 20 den 28 'e gidiyor. Ama ikincinin her değişmesinde "X" in oturacağı hücre 1 yakınlaşıyor. Bunun için ikincinin her değişiminde 1 artan üçüncü değişken nasıl kurgulanır?
Yani aynı anda iki farklı değişkenin değeri nasıl değişir? (k 'ya nasıl değer verdirebilirim?
Aşağıdaki de kullandığım kod,

Sub XY_Bas()
Dim rng, c As Range
Dim x, y, k As Integer
    For y = 20 To 28 Step 2
        For x = 1 To 31
            Set rng = Cells(8 + x, y)
'            Set rng = Cells(55 + x, y)
'           ...
                For Each c In rng
                    If c.Interior.Color = RGB(217, 217, 217) Then
                        c.Offset(, 20 - k) = "X"
                    End If
                Next
        Next x
    Next y
End Sub

Saygılarımla

 

[systran]

K değerini X e göre değişitrmeyi denediniz mi?
K = 100 - x gibi ???

 

[Tevfik_Kursun]

Sayın Systran Hocam,
Dikkatinizi çekmiştir, x: 1 ie 31 arasında bir atlayarak, y: 20 - 28 arasında 2 atlayarak artıyor. Ama k 20 den 16 ya iniyor. Hem de y 20 iken 20, 22 iken 19, 24 iken 18, 26 iken 17 ve 28 iken 16 oluyor.
x müstakil ama y ve k birlikte değişiyor. Matematiksel olarak oturtamadım. Burada bana göre soru bu. İki değişken birlikte nasıl değişir?
Saygılarımla

 

[PLİNT]

Merhaba Tevfik bey
Dosya örneğini buraya da eklermisiniz?
Aşağıdaki gibi bir çözüm aklıma geldi ama dosyayı görmeden olumlu sonuç verirmi, isteğinizin daha geniş çaplımı karar veremedim

For Each j In Range("AN1:AR31")
x = right(j.Column, 1) * 2
If Cells(j.Row, (j.Column - 20) + x).Interior.Color = RGB(217, 217, 217) Then j.Value = "X"
Next

 

[Tevfik_Kursun]

Sayın Plint,
İlginize teşekkürler,
Deneme_1
Sanırım bunu demek istediniz
Saygılarımla

 

[PLİNT]

Merhaba
Dosyanıza göre aşağıdaki gibi döngü iş görüyor yeterli olurmu acaba?

https://www.dosyaupload.com/b7ll

Private Sub CommandButton1_Click()
For Each j In Range("AN9:AR269")
x = Right(j.Column, 1) * 2
If Cells(j.Row, 20 + x).Interior.Color = RGB(217, 217, 217) Then j.Value = "X"
Next
End Sub

döngüyü şöylede ayarlayabilirsiniz
For Each j In Range("AN9:AR39,AN55:AR85,AN101:AR131,AN147:AR177,.........................")

 

[Tevfik_Kursun]

Sayın Plint Hocam,
Harika olmuş arkadaşım. İlginize çok teşekkür ederim.
Bir sorun var. Belirlenen bölgelerin dışında da aynı dolgu varsa onunda hizasına "X" işareti koyacaktır. Bunu düşünmek lazım.
Bir de makrodan RGB değeri verileceğine bu değeri bir hücreden alabilir mi?
Saygılarımla

 

[PLİNT]

Merhaba
Rica ederim, saygı bizden Tevfik bey.
Döngü aralıkları şöyle ayarlanabilir

For Each j In Range("AN9:AR39,AN55:AR85,AN101:AR131,AN147:AR177,AN193:AR223,AN239:AR269")

veya

Private Sub CommandButton1_Click()
For c = 9 To 239 Step 10
For Each j In Range("AN" & c & ":AR" & c + 30)
x = Right(j.Column, 1) * 2
If Cells(j.Row, 20 + x).Interior.Color = RGB(217, 217, 217) Then j.Value = "X"
Next
Next
End Sub

Bir de makrodan RGB değeri verileceğine bu değeri bir hücreden alabilir mi?

başka hücre rengi gibimi?
If Cells(j.Row, 20 + x).Interior.Color = [A1].Interior.Color Then

 

[Tevfik_Kursun]

Sayın Plint Hocam,
Sanırım hemen çalışmama uyarlayabilirim. Çok teşekkür ederim. Her gün yeni şeyler öğreniyorum.
Saygılarımla

 

[PLİNT]

Rica ederim, işlerinizde kolaylıklar dilerim.
Bu arada uğraşınca yukarıdaki kodlarınızdan şöyle bir sonuç çıktı alternatif olsun

Private Sub CommandButton1_Click()
Dim n As Long, y As Long
Dim v, r As Integer
For n = 9 To Cells(Rows.Count, "S").End(3).Row
v = v + 1
    For y = 20 To 28 Step 2
    r = r + 1
    If Cells(n, y).Interior.Color = RGB(217, 217, 217) Then Cells(n, y + 21 - r) = "X"
    Next
    r = 0
If v = 31 Then
n = n + 15
v = 0
End If
    Next
End Sub

 

[Tevfik_Kursun]

İlginize tekrar teşekkür ederim, çalışmam da tam istediğim gibi oldu.
Saygılarımla

 

[PLİNT]

Bir önceki mesajımdaki kodlarda hata farkettim şöyle kullanın
"step 10" yerine "step 46" yapalım

Private Sub CommandButton1_Click()
Application.Calculation = xlCalculationManual
For c = 9 To 269 Step 46
For Each j In Range("AN" & c & ":AR" & c + 30)
x = Right(j.Column, 1) * 2
If Cells(j.Row, 20 + x).Interior.Color = RGB(217, 217, 217) Then j.Value = "X"
Next
Next
Application.Calculation = xlCalculationAutomatic
End Sub

 

[Tevfik_Kursun]

Sayın Hocam,
Evet, ben de şimdi gördüm.
Teşekkür ederim.
Saygılarımla

 

[PLİNT]

Rica ederim, Allah kolaylıklar versin, hayırlı geceler.

 

[Tevfik_Kursun]

Hayırlı geceler arkadaşım