makro

Sub UpdateProjectIDs()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long
    Dim i As Long, j As Long
    Dim lookupValue As String, projectID As String
    Dim cellValue As String
    Dim found As Boolean
    
    ' Sheet1 ve Sheet2'yi ayarla
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    
    ' Sheet1'deki son satırı bul
    lastRow1 = ws1.Cells(ws1.Rows.Count, "B").End(xlUp).Row
    
    ' Sheet2'deki son satırı bul
    lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
    
    ' Sheet2'deki dictionary'yi kontrol et
    For i = 2 To lastRow1 ' Sheet1'deki B sütununu kontrol et
        cellValue = ws1.Cells(i, 2).Value ' B sütunundaki hücreyi al
        found = False
        
        ' Sheet2'deki lookup dictionary'yi kontrol et
        For j = 2 To lastRow2
            lookupValue = ws2.Cells(j, 1).Value ' UJB değerini al
            projectID = ws2.Cells(j, 2).Value ' Project ID değerini al
            
            ' Lookup değerini metnin içinde ara
            If InStr(1, cellValue, lookupValue, vbTextCompare) > 0 Then
                ws1.Cells(i, 3).Value = projectID ' Eşleşirse Project ID'yi C sütununa yaz
                found = True
                Exit For
            End If
        Next j
        
        ' Eğer eşleşme bulunmazsa, hücreyi boş bırak
        If Not found Then
            ws1.Cells(i, 3).Value = "" ' Hücreyi boş bırak
        End If
    Next i
End Sub