Sub KelimeleriDeğiştir()
    Dim veriSayfa As Worksheet
    Dim kisaltmaSayfa As Worksheet
    Dim veriSutun As Range
    Dim kisaltmaSutunA As Range
    Dim kisaltmaSutunB As Range
    Dim veriHücre As Range
    Dim kisaltmaBulundu As Boolean
    Dim kelimeListesi() As String
    Dim yeniCümle As String
    
    ' Çalışma sayfalarını belirleyin
    Set veriSayfa = ThisWorkbook.Sheets("veri")
    Set kisaltmaSayfa = ThisWorkbook.Sheets("kisaltma")
    
    ' Sütunları belirleyin
    Set veriSutun = veriSayfa.Range("D1:D" & veriSayfa.Cells(veriSayfa.Rows.Count, "D").End(xlUp).Row)
    Set kisaltmaSutunA = kisaltmaSayfa.Range("A1:A" & kisaltmaSayfa.Cells(kisaltmaSayfa.Rows.Count, "A").End(xlUp).Row)
    Set kisaltmaSutunB = kisaltmaSayfa.Range("B1:B" & kisaltmaSayfa.Cells(kisaltmaSayfa.Rows.Count, "B").End(xlUp).Row)
    
    ' Her "veri" cümlesini kontrol edin ve eşleşen varsa kelimeleri değiştirin
    For Each veriHücre In veriSutun
        kisaltmaBulundu = False
        If veriHücre.Value <> "" Then
            kelimeListesi = Split(veriHücre.Value, " ") ' Cümleyi kelimelere ayır
            yeniCümle = ""
            For Each kelime In kelimeListesi
                If WorksheetFunction.CountIf(kisaltmaSutunA, kelime) > 0 Then
                    ' Eşleşen kelimenin yerine "kisaltma" sayfasının B sütunundaki değeri kullan
                    yeniCümle = yeniCümle & WorksheetFunction.VLookup(kelime, kisaltmaSutunA.Resize(, 2), 2, False) & " "
                    kisaltmaBulundu = True
                Else
                    ' Eşleşen kelime yoksa aynı kelimeyi kullan
                    yeniCümle = yeniCümle & kelime & " "
                End If
            Next kelime
            ' Son boşluk karakterini kaldır
            yeniCümle = Left(yeniCümle, Len(yeniCümle) - 1)
            
            ' Eşleşen kelimeleri içeren cümleyi "veri" sayfasındaki hücreye yaz
            If kisaltmaBulundu Then
                veriHücre.Value = yeniCümle
            End If
        End If
    Next veriHücre
End Sub