Kod Yardım

[Erdogan3434]

Merhabalar,

Aşağıdaki şekilde düzenlemiş olduğum kodumda Msgbox'a konu olan hatanın gelmesi ile hataya konu olan bölümün 23 ve 27'ci sütun arasının kırmızı renge boyanmasını hata düzeltilirse renksiz olarak düzelmesini sağlamayı hedeflemekteyim.

y = Sheets("Sayfa1").Cells(Rows.Count, 22).End(xlUp).Row
For X = 3 To y
If Sheets("Sayfa1").Cells(X, 22) = Sheets("Sayfa1").Cells(3, 1) And Sheets("Sayfa1").Cells(X, 23) = Sheets("Sayfa1").Cells(1, 3) Then
If Sheets("Sayfa1").Cells(1, 3).End(xlDown).Row = 5 Then
h = h + 1
If h > 1 Then
GoTo 2
Else
MsgBox Sheets("Sayfa1").Cells(1, 3) & " tarihinde " & Sheets("Sayfa1").Cells(3, 1) & " hatalıdır."
End If
Else
a = Sheets("Sayfa1").Cells(1, 3).End(xlDown).Row + 1

Sheets("Sayfa1").Cells(a, 3) = Sheets("Sayfa1").Cells(X, 24)
Sheets("Sayfa1").Cells(a, 4) = Sheets("Sayfa1").Cells(X, 25)
Sheets("Sayfa1").Cells(a, 5) = Sheets("Sayfa1").Cells(X, 26)
Sheets("Sayfa1").Cells(a, 6) = Sheets("Sayfa1").Cells(X, 27)
a = 0
End If
End If

Desteğiniz ricasıyla.

 

[ÖmerFaruk]

Kodlarınızın doğru çalıştığını kabul ederek aşağıdaki eklemeleri yapabilirsiniz.

    y = Sheets("Sayfa1").Cells(Rows.Count, 22).End(xlUp).Row
    For x = 3 To y
        If Sheets("Sayfa1").Cells(x, 22) = Sheets("Sayfa1").Cells(3, 1) And Sheets("Sayfa1").Cells(x, 23) = Sheets("Sayfa1").Cells(1, 3) Then
            If Sheets("Sayfa1").Cells(1, 3).End(xlDown).Row = 5 Then
                h = h + 1
                If h > 1 Then
                    GoTo 2
                    'hata yok dolguyu kaldır
                    Sheets("Sayfa1").Range(Cells(x, 23), Cells(x, 27)).Interior.Color = xlNone
                Else
                    MsgBox Sheets("Sayfa1").Cells(1, 3) & " tarihinde " & Sheets("Sayfa1").Cells(3, 1) & " hatalıdır."
                   'hata var...kırmızı dolgu yap
                    Sheets("Sayfa1").Range(Cells(x, 23), Cells(x, 27)).Interior.Color = vbRed
                End If
                Else
                a = Sheets("Sayfa1").Cells(1, 3).End(xlDown).Row + 1
                Sheets("Sayfa1").Cells(a, 3) = Sheets("Sayfa1").Cells(x, 24)
                Sheets("Sayfa1").Cells(a, 4) = Sheets("Sayfa1").Cells(x, 25)
                Sheets("Sayfa1").Cells(a, 5) = Sheets("Sayfa1").Cells(x, 26)
                Sheets("Sayfa1").Cells(a, 6) = Sheets("Sayfa1").Cells(x, 27)
                a = 0
            End If
        End If
    Next x

 

[Erdogan3434]

Merhaba,
Kodun çalışmasından yana problem yok. Desteğiniz için çok teşekkür ederim.
Saygılarımla,

 

[ÖmerFaruk]

Rica ederiz. Kolay gelsin.