Hücre rengi

muratgunay48 · Pazartesi saat 00:06'de

Arkadaşlar, sayın hocalarım, koşullu biçimlendirme ile oluyor da,

Sayfa1 A1, Sayfa2 A1' eşit değilse hücre kırmızı olsun makro ile lazım

Şöyle yazmaya çalıştım hata verdi. Hata nerede acaba?
Teşekkür ederim. Saygılarımla.

Kod:

Sub test()
If Sheets("Sayfa1").Range("A1") <> Sheets("Sayfa2").Range("A1") Then
   Sheets("Sayfa1").Range("A1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub

systran · Pazartesi saat 00:07'de

Sheets("Sayfa1").Range("A1").Value ya da
Sheets("Sayfa1").Range("A1").Text olarak karşılaştırmayı denedin mi?

muratgunay48 · Pazartesi saat 00:23'de

systran' Alıntı:
Sheets("Sayfa1").Range("A1").Value ya da
Sheets("Sayfa1").Range("A1").Text olarak karşılaştırmayı denedin mi?

Hocam denedim ama şöyle hata alıyorum.

systran · Pazartesi saat 00:25'de

End with ile End Sub arasında End if yazmanız gerekiyor

muratgunay48 · Pazartesi saat 00:37'de

systran' Alıntı:
End with ile End Sub arasında End if yazmanız gerekiyor

Hocam çok teşekkür ederim. Nasıl atladım onu.

muratgunay48 · Pazartesi saat 00:43'de

systran' Alıntı:
End with ile End Sub arasında End if yazmanız gerekiyor

Hocam peki bu kodu A1 değil de A1: E5 kadar yapmak istesek. Range olarak yazsam yine farklı olanları kırmızı yapar mı?

muratgunay48 · Pazartesi saat 07:19'de

systran' Alıntı:
End with ile End Sub arasında End if yazmanız gerekiyor

Hocam çoklu yapmak için şu şekilde yaptım olmadı.

Kod:

Sub test()

If Sheets("Sayfa1").Range("B2,B3,B4,B5,B6,B7,B8,B9,B10").Value <> Sheets("Sayfa2").Range("B2,B3,B4,B5,B6,B7,B8,B9,B10").Value Then
    Sheets("Sayfa1").Range("B2,B3,B4,B5,B6,B7,B8,B9,B10").Select
  
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
 End If
 
End Sub

catalinastrap · Pazartesi saat 11:40'de

Sub HighlightDifferences()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim cell1 As Range
Dim cell2 As Range

Set ws1 = Sheets("Sayfa1")
Set ws2 = Sheets("Sayfa2")
Set rng1 = ws1.Range("B2:B10")
Set rng2 = ws2.Range("B2:B10")
For Each cell1 In rng1
Set cell2 = rng2.Cells(cell1.Row - rng1.Row + 1, 1)
If cell1.Value <> cell2.Value Then
With cell1.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next cell1
MsgBox "Karşılaştırma tamamlandı.", vbInformation
End Sub

kodu denermisiniz

muratgunay48 · Pazartesi saat 13:39'de

catalinastrap' Alıntı:
Sub HighlightDifferences()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim cell1 As Range
Dim cell2 As Range

Set ws1 = Sheets("Sayfa1")
Set ws2 = Sheets("Sayfa2")
Set rng1 = ws1.Range("B2:B10")
Set rng2 = ws2.Range("B2:B10")
For Each cell1 In rng1
Set cell2 = rng2.Cells(cell1.Row - rng1.Row + 1, 1)
If cell1.Value <> cell2.Value Then
With cell1.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next cell1
MsgBox "Karşılaştırma tamamlandı.", vbInformation
End Sub

kodu denermisiniz

Hocam cevabınız için teşekkür ederim.
Hocam şu şekilde oldu. Dosyayı attım size. Tekli olan sadece A1

catalinastrap · Pazartesi saat 13:54'de

Eki incelermisiniz

muratgunay48 · Pazartesi saat 15:11'de

catalinastrap' Alıntı:
Eki incelermisiniz

Hocam çok teşekkür ederim. Tam istediğim gibi. Elinize emeğinize sağlık.

catalinastrap · Pazartesi saat 15:19'de

Rica ederim Kolay gelsin

muratgunay48 · Pazartesi saat 23:58'de

catalinastrap' Alıntı:
Rica ederim Kolay gelsin

Şimdi bunu internetten bulduğum kodlarla revize ettiğim sudokuya uyarlayacağım. Finali olmuyordu çünkü.

muratgunay48 · Dün 00:15 da

@catalinastrap hocam normale çalışan kodlar puntoları değiştirdi ve düzgün çalışmadı. Neden acaba. Excel dosyasında normal çalışıyor bu kodlar.
Sanırım A1:d10 kısmını B2:J10 olarak çeviremedim.
Hocam 3. Kez yorumumu değiştiriyorum ama kodlarınızda tam çözemedim, kapsadığı hücreleri nasıl değiştireceğim. 1. Sütundan değil 3. Sütundan başlarsa ve C3:F10 olursa. Değiştirmeyi öğretirseniz size zahmet.

Kod:

Sub test1()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Dim cell1 As Range
    Dim cell2 As Range
    Dim col As Integer

    Set ws1 = Sheets("Sayfa1")
    Set ws2 = Sheets("Sayfa2")
    ws1.Range("A1:D10").ClearFormats
    ws2.Range("A1:D10").ClearFormats

    For col = 1 To 4

    Set rng1 = ws1.Range(ws1.Cells(1, col), ws1.Cells(10, col))
    Set rng2 = ws2.Range(ws2.Cells(1, col), ws2.Cells(10, col))

     For Each cell1 In rng1

            Set cell2 = rng2.Cells(cell1.Row, 1)

            If cell1.Value <> cell2.Value Then
           
                With cell1.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 255
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
            End If
        Next cell1
    Next col    

    With ws1.Range("A1:D10").Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 0
    End With

    With ws2.Range("A1:D10").Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 0
    End With

    MsgBox "Karşılaştırma tamamlandı.", vbInformation

End Sub

muratgunay48 · Dün 08:25 da

@catalinastrap hocam, hiç uğraşmadan soruyor demeyesiniz. Kodlarınızda sütun olayını kavradım. Ancak 1. Sütundan olursa yapabildim. 20 satır da olsa sorun yok yapabildim. Ancak 2. Satırdan başlama nasıl çözemedim. Yardımcı olursanız sevinirim. Aslında burada olması lazım ama rakamları değiştirince kıpkırmızı oluyor.
Set rng1 = ws1.Range(ws1.Cells(1, col), ws1.Cells(10, col)) 'İlk sayfa satır başlangıç ve sonu

Lütfen geç bakarsam saygısızlık olarak almayın. Ben gece çalışıyorum. Gündüz yatıyorum.
Umarım B2:J10 olayını yaparsak kontrol et deyince hücre puntoları değişmez, şu an yapınca yazılar küçülüyor. Dosyayı atmıştım size.

Kod:

Sub test1()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Dim cell1 As Range
    Dim cell2 As Range
    Dim col As Integer

 
    Set ws1 = Sheets("Sayfa1")
    Set ws2 = Sheets("Sayfa2")
    ws1.Range("B1:G10").ClearFormats 'İlk sayfa hücreleri
    ws2.Range("B1:G10").ClearFormats 'İkinci sayfa hücreleri
  
    For col = 2 To 7 'Sütun kaçtan kaça
      
        Set rng1 = ws1.Range(ws1.Cells(1, col), ws1.Cells(10, col)) 'İlk sayfa satır başlangıç ve sonu
        Set rng2 = ws2.Range(ws2.Cells(1, col), ws2.Cells(10, col)) 'İkinci sayfa satır başlangıç ve sonu
                       For Each cell1 In rng1
          
            Set cell2 = rng2.Cells(cell1.Row, 1)
        
            If cell1.Value <> cell2.Value Then
              
                With cell1.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 255
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
            End If
        Next cell1
    Next col
      
    With ws1.Range("B1:G10").Borders 'İlk sayfa hücreleri
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 0
    End With
    
    With ws2.Range("B1:G10").Borders 'İkinci sayfa hücreleri
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 0
    End With
    MsgBox "Karşılaştırma tamamlandı.", vbInformation
End Sub

muratgunay48 · Dün 20:29 da

catalinastrap' Alıntı:
Eki incelermisiniz

Set cell2 = rng2.Cells(cell1.Row, 1)

If cell1.Value <> cell2.Value Then

Hocam, 2. 3. 4. 5. Satırdan başlatabilmek için (diğerlerini yazmıştım)
Sanırım kodun bu kısmında takılıyorum ve kaçıncı satırdan başlatabileceğim sanırım bu kısım ile alakalı.
Yardımınızı rica etsem.

Shadomexes · Bugün 00:51

ws1.Range("B2:G10").ClearFormats 'İlk sayfa hücreleri
ws2.Range("B2:G10").ClearFormats 'İkinci sayfa hücreleri

For col = 2 To 7 'Sütun kaçtan kaça

Set rng1 = ws1.Range(ws1.Cells(2, col), ws1.Cells(10, col)) 'İlk sayfa satır başlangıç ve sonu
Set rng2 = ws2.Range(ws2.Cells(2, col), ws2.Cells(10, col))

Bu şekilde dener misiniz ayrıca B1:G10 kısımların hepsini B2:G10 olarak dener misiniz

muratgunay48 · Bugün 01:57

Shadomexes' Alıntı:
ws1.Range("B2:G10").ClearFormats 'İlk sayfa hücreleri
ws2.Range("B2:G10").ClearFormats 'İkinci sayfa hücreleri

For col = 2 To 7 'Sütun kaçtan kaça

Set rng1 = ws1.Range(ws1.Cells(2, col), ws1.Cells(10, col)) 'İlk sayfa satır başlangıç ve sonu
Set rng2 = ws2.Range(ws2.Cells(2, col), ws2.Cells(10, col))

Bu şekilde dener misiniz ayrıca B1:G10 kısımların hepsini B2:G10 olarak dener misiniz

Hocam cevabınız için teşekkür ederim. Bu şekilde denedim hocam, alakasız yerleri (neden olduğunu bile bilmiyorum) kırmızıya boyuyor.
Eğer yanlış görmediysem
Set rng1 = ws1.Range(ws1.Cells(2, col), ws1.Cells(10, col)) 'İlk sayfa satır başlangıç ve sonu
Set rng2 = ws2.Range(ws2.Cells(2, col), ws2.Cells(10, col))
Cells(2, col), burası 2 olarak değişmiş. Bunu yaptım. İsterseniz size örnek dosya atayım inceleyin.
İNDİR

Hücre rengi

muratgunay48

systran

Destek Ekibi

muratgunay48

systran

Destek Ekibi

muratgunay48

muratgunay48

muratgunay48

catalinastrap

Destek Ekibi

muratgunay48

Ekli dosyalar

catalinastrap

Destek Ekibi

Ekli dosyalar

muratgunay48

catalinastrap

Destek Ekibi

muratgunay48

muratgunay48

Ekli dosyalar

muratgunay48

muratgunay48

Shadomexes

muratgunay48