Excel'de Seçili Sayfalarda Çoklu Kriterde Satır Boyamak

GPT üzerinde şu istek üretildi.

Excel'de adları "Dizüstü", "Kasa", "Takım", "Tümleşik", "Ekran" olan sayfalarda, başlığı "tckn_yerlesim_yeri" olan sütun bulunacak ve bu sütunda 11 basamaklı yinelenen sayıların bulunduğu satır kırmızı renge boyanacak. Bunun için VBA kodu yaz.

Sub TCKN_Yinelenenleri_Kirmiziya_Boya() Dim sayfalar As Variant Dim ws As Worksheet Dim baslikHucresi As Range Dim kontrolSutun As Long Dim sonSatir As Long Dim i As Long Dim sayac As Object Dim deger As String ' Kontrol edilecek sayfa adları sayfalar = Array("Dizüstü", "Kasa", "Takım", "Tümleşik", "Ekran") For Each ws In ThisWorkbook.Worksheets If Not IsError(Application.Match(ws.Name, sayfalar, 0)) Then ' Başlığı bul Set baslikHucresi = ws.Rows(1).Find(What:="tckn_yerlesim_yeri", _ LookAt:=xlWhole, _ MatchCase:=False) If Not baslikHucresi Is Nothing Then kontrolSutun = baslikHucresi.Column sonSatir = ws.Cells(ws.Rows.Count, kontrolSutun).End(xlUp).Row Set sayac = CreateObject("Scripting.Dictionary") ' Sayıları say For i = 2 To sonSatir deger = Trim(ws.Cells(i, kontrolSutun).Value) If Len(deger) = 11 And IsNumeric(deger) Then If sayac.Exists(deger) Then sayac(deger) = sayac(deger) + 1 Else sayac.Add deger, 1 End If End If Next i ' Yinelenenleri kırmızıya boya For i = 2 To sonSatir deger = Trim(ws.Cells(i, kontrolSutun).Value) If Len(deger) = 11 And IsNumeric(deger) Then If sayac(deger) > 1 Then ws.Rows(i).Interior.Color = RGB(255, 128, 128) End If End If Next i End If End If Next ws MsgBox "Yinelenen 11 basamaklı TCKN'ler kırmızıya boyandı.", vbInformation End Sub