• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Soru Personel Malzeme Zimmet Karşılaştırma 2022

  • Konbuyu başlatan Konbuyu başlatan yyhy
  • Başlangıç tarihi Başlangıç tarihi

yyhy

Altın Üye
Katılım
3 Aralık 2005
Mesajlar
946
Excel Vers. ve Dili
Microsoft Office 2021 TR
Microsoft 365 TR
Personel Malzeme Zimmet Karşılaştırma dosyasında iki sütundaki farklılıkları Koşullu Biçimlendirme veya Macro ile renklendirebilir miyiz?
 

Ekli dosyalar

Sayın yyhy Bu şekilde işinizi görür mü , daha profesyonel bir çalışma mı arıyorsunuz ?



Snap 2022-02-10 at 16.00.33.jpg
 
Personel Malzeme Zimmet Karşılaştırma dosyasında iki sütundaki farklılıkları Koşullu Biçimlendirme veya Macro ile renklendirebilir miyiz?

Tabloya 3 sütun ekleyip , Sadece Düşey ara ve koşullu biçimlendirme kullandım.
 
Sayın @ozanyakar şimdilik işimizi görür ama farklı yöntem ve çalışma olsa daha iyi olur. Kullanan arkadaşlar formülleri yanlışlıkla kaydırdığında veya formülü bozduğunda sorun olur diye düşünüyorum.
 
Sayın @ozanyakar şimdilik işimizi görür ama farklı yöntem ve çalışma olsa daha iyi olur. Kullanan arkadaşlar formülleri yanlışlıkla kaydırdığında veya formülü bozduğunda sorun olur diye düşünüyorum.
 

Ekli dosyalar

Sayın @ozanyakar dosyada ben bir değişiklik göremedim. Yanlış dosya mı eklediniz acaba?
Ek dosyada; Koşullu Biçimlendirme, Eklenen yardımcı sütun veya formül de göremedim.
 
Merhaba, dener misiniz?
Kod:
Sub test()
Dim veri As Worksheet
Set veri = Sheets("Veri")

Application.ScreenUpdating = False
bson = veri.Cells(Rows.Count, 2).End(3).Row
veri.Range("B10:B" & bson).Interior.Color = xlNone
veri.Range("D10:D" & bson).Interior.Color = xlNone

For i = 10 To bson
    b = WorksheetFunction.CountIf(veri.Range("D10:D" & bson), veri.Cells(i, 2))
    d = WorksheetFunction.CountIf(veri.Range("B10:B" & bson), veri.Cells(i, 4))
    
    If b = 0 Then
        veri.Cells(i, 2).Interior.Color = vbGreen
    End If
    
    If d = 0 Then
        veri.Cells(i, 4).Interior.Color = vbRed
    End If
Next

Application.ScreenUpdating = True
End Sub
 
Geri
Üst