Çözüldü If döngü hatası

[brod12]

Merhaba. Fotoğrafta görürdüğü gibi if döngüsü kullanmaya çalıştım ama beceremedim. Benim istediğim hücre rengi değiştir butonuna bastığımda emin misin diye sorsun. Eğer msgboxa evet dersem sütunları boyasın ve renkler güncellendi bilgisini versin istiyorum. Ama bu soruyu tek bir kere değil 6 kere filan soruyor bazen sonsuz döngüye giriyor. Hayır dersemde renkler güncellenmedi bilgisini versin ve boyama yapmasın. Yardımlarınızı bekliyorum.
Yazılı olan kodun resmi

 

[çıtır]

Deneyiniz.

Private Sub CommandButton1_Click()
Dim hcr As Range
sor = MsgBox("Renkler güncellensin mi?", vbYesNo + vbQuestion)
For Each hcr In Range("D3:D20")
If sor = 6 Then
hcr.Interior.Color = 13995347

Else
MsgBox "Renkler güncellenmedi"
Exit Sub
End If
Next
MsgBox "Renkler günceldi"
End Sub

 

[brod12]

Deneyiniz.

Private Sub CommandButton1_Click()
Dim hcr As Range
sor = MsgBox("Renkler güncellensin mi?", vbYesNo + vbQuestion)
For Each hcr In Range("D3:D20")
If sor = 6 Then
hcr.Interior.Color = 13995347

Else
MsgBox "Renkler güncellenmedi"
Exit Sub
End If
Next
MsgBox "Renkler günceldi"
End Sub

Buton çalıştı ama renk değişikliği olmadı yazılan satır aralıkları hep aynı renk yapıyor. Orada yazdığım kodlar ile örnek sarıyı kırmızı kırmızıyı mavi böyle değiştire değiştire gitmedi.

 

[çıtır]

Buton çalıştı ama renk değişikliği olmadı yazılan satır aralıkları hep aynı renk yapıyor. Orada yazdığım kodlar ile örnek sarıyı kırmızı kırmızıyı mavi böyle değiştire değiştire gitmedi.

O zaman önceki kodla çalışmalısınız her satırdaki sorguya göre işlem devam etmeli.Sorunuzun bundan kurtulma istediğiniz şeklinde anladım.

 

[brod12]

Aslında bu evet hayırı eklemeden önce herşey güzel çalışıyordu. Ama ben bunuda eklemek istiyorum. Ama bir türlü beceremedim. Her renk değiştirmesinde evet hayır penceresi çıkıyor.

 

[FERAZ]

For each ile mantıksız olmuş gibi.
Mesela hücreyi seçip butona basınca soru sorup işlem yapılabilir.Böylece seçilen renklenir.

 

[brod12]

Buradaki mantık farklı renklerde hücreler var. Kırmızı, mavi, yeşil, turuncu vb. butona basınca benim belirlediğim sıra ile maviyi kırmızıya, kırmızıyı yeşile, yeşili turuncuya çeviriyor.Tek tek hücre seçme yok belirlediğim aralık içindeki bütün hücreler için geçerli oluyor. Bu böyle devam ediyor. Benim istediğim butona basınca tek bir defa emin misin diye sorsun ona göre işlem yapsın.

 

[Orion1]

Buyurun.

Private Sub CommandButton1_Click()
Dim hcr As Range
If MsgBox("Renkler güncellensin mi?", vbYesNo + vbQuestion) = vbYes Then
For Each hcr In Range("D3:D20")
hcr.Interior.Color = 13995347
Next
GoTo 10
Else
MsgBox "Renkler güncellenmedi"
Exit Sub
End If
10:
MsgBox "Renkler günceldi"
End Sub

 

[Necdet]

Örnek dosya eklemezseniz daha çok yazışırsınız.

 

[brod12]

Buyurun.

Private Sub CommandButton1_Click()
Dim hcr As Range
If MsgBox("Renkler güncellensin mi?", vbYesNo + vbQuestion) = vbYes Then
For Each hcr In Range("D3:D20")
hcr.Interior.Color = 13995347
Next
GoTo 10
Else
MsgBox "Renkler güncellenmedi"
Exit Sub
End If
10:
MsgBox "Renkler günceldi"
End Sub

Elinize sağlık sorunsuz çalıştı. İlginizden dolayı teşekkür ederim. Ben birde nöbet çetele konusu açmıştım. Size zahmet olmazsa onada bakabilir misiniz?

 

[brod12]

Buyurun.

Private Sub CommandButton1_Click()
Dim hcr As Range
If MsgBox("Renkler güncellensin mi?", vbYesNo + vbQuestion) = vbYes Then
For Each hcr In Range("D3:D20")
hcr.Interior.Color = 13995347
Next
GoTo 10
Else
MsgBox "Renkler güncellenmedi"
Exit Sub
End If
10:
MsgBox "Renkler günceldi"
End Sub

Kod fotoğrafı
Ufak bir hata daha gerçekleşti. Şuan hayır dersem sütunları boyamıyor ve güncellenmedi bilgisini veriyor. Bunda sıkıntı yok ama evet dediğimde 2 kere güncellendi 1 kere güncellenmedi uyarısı veriyor.

 

[Orion1]

Kod fotoğrafı
Ufak bir hata daha gerçekleşti. Şuan hayır dersem sütunları boyamıyor ve güncellenmedi bilgisini veriyor. Bunda sıkıntı yok ama evet dediğimde 2 kere güncellendi 1 kere güncellenmedi uyarısı veriyor.

2 Kere mesaj vermesine imkan yok.
Bakın örnek dosya için link verdim.
İndirip deneyiniz.

DOSYAYI INDIR
...

 

[brod12]

2 Kere mesaj vermesine imkan yok.
Bakın örnek dosya için link verdim.
İndirip deneyiniz.

DOSYAYI INDIR
...

Evet sizinki hata vermiyor ama benim kodlar farklı. Tek renk değişikliği yapmıyorum 5 renk değişikliği yaptığımdan dolayı ekleme yaptım.

 

[Orion1]

Örnek dosyanızı ekleyin bakayım.

 

[Orion1]

Örnek dosya eklemezseniz daha çok yazışırsınız.

 

[brod12]

Evet haklısınız ama bende askeri birlikteyim bu bilgisayarlarda internet yok ve herhangi bir bellek, cd vb. şeyler takılmıyor. Ondan dolayı fotoğraf yükledim. Ama başka türlü yüklemeyi deniyim.

 

[Orion1]

Yüklediğiniz fotoğrafta sadece bir hücreye bir renk ekleniyor.
Yazdığınız kodlardaki en alttaki kod rengi geçerli olur.

 

[Orion1]

Şöyle deneyin.

Sub DoluÇerçeve1_Tıklat()
Dim hcr As Range
If MsgBox("Renkler güncellensin mi?", vbYesNo + vbQuestion) = vbYes Then
For Each hcr In Range("D3:D20")
hcr.Interior.Color = 13995347
'kodlarınız
'kodlarınız
'kodlarınız
Next
GoTo 10
Else
MsgBox "Renkler güncellenmedi"
Exit Sub
End If
10:
MsgBox "Renkler günceldi"
End Sub

 

[brod12]

Şöyle deneyin.

Sub DoluÇerçeve1_Tıklat()
Dim hcr As Range
If MsgBox("Renkler güncellensin mi?", vbYesNo + vbQuestion) = vbYes Then
For Each hcr In Range("D3:D20")
hcr.Interior.Color = 13995347
'kodlarınız
'kodlarınız
'kodlarınız
Next
GoTo 10
Else
MsgBox "Renkler güncellenmedi"
Exit Sub
End If
10:
MsgBox "Renkler günceldi"
End Sub

Sanırsam ihtiyacımız olan "Exit Sub" koduymuş.Sayenizde hallettim sabrınız ve ilginizden dolayı teşekkür ederim.

 

[Orion1]

Sanırsam ihtiyacımız olan "Exit Sub" koduymuş.Sayenizde hallettim sabrınız ve ilginizden dolayı teşekkür ederim.

Rica ederim.
İyi çalışmalar.