Cümle kelimelerini birleştirme

[asitetik]

Merhaba;
konu daha önce varsa kusura bakmayınız ben bulamadım.

Sorum şu şekilde.

A hücresinde "Ali bugün bize gel" yazıyor

B hücresine "Ali bugün, Ali, Bize, Ali Gel, Bugün Ali, Bugün bize, Bugün Gel, Bize Ali, bize bugün, bize gel..."

A hücresinden çıkacak tüm kambinasyonları B hücresine yazdırmam gerekiyor.
yardımcı olabilecek olan varsa memnun olurum.

Teşekkürler

 

[asitetik]

Başlıkta kelimelerini yazacağıma kelimlerini yazmışım.
Özür

 

[çıtır]

Sadece bu cümle için mi? Başka cümlelerde var mı? Onlarda dört kelimeden mi oluşuyor? Bilgi verseydiniz üzerinde çalışırdık. Verdiğiniz örnek tek ve bir cümle,sonra istekler artıyor.Sıkıcı ve gereksiz uğraş oluyor.Bazende bizim bilgimizi aşıyor.Lütfen yeterli açıklama yapınız.Benim gibi bilgisi sınırlı sadece vakit geçirmek için yardıma çalışan arkadaşları gereksiz yormayalım değil mi?:yazici:

 

[asitetik]

Uyarınız için teşekkür ederim.
Aslında durum şudur.
Elimde 12.000 adet ürün bulunan bir liste var.
burada 3 kelime olanda var 20 kelime olanda.

Amacım ise arama için etiket oluşturmak.

Çünkü kullandığımız saçma e-ticaret altyapımız 2 kelime peş peşe gelmeyince sonuç getirmiyor.

Örnek:
Calming A.I Body Lotion 400 ml - Vücut Losyonu
Bro Arnica Jel 150 ml

 

[Korhan Ayhan]

Merhaba,

Klasik döngü yöntemiyle bir şeyler karaladım. Deneyiniz.

Sub ETİKETLE()
    Application.ScreenUpdating = False
    
    Range("B:B").ClearContents
    
    For X = 1 To Cells(Rows.Count, 1).End(3).Row
        If Cells(X, 1) <> "" Then
            Veri = Split(Cells(X, 1).Value, " ")
            For Y = 0 To UBound(Veri)
                Ana_Etiket = Veri(Y) & " "
                Say = 1
                For Z = Y + 1 To UBound(Veri)
                    Etiket = Ana_Etiket & " " & Veri(Z)
                    Say = Say + 1
                    If Say = 2 Then
                        Cells(X, 2) = IIf(Cells(X, 2) = "", Etiket, Cells(X, 2) & ", " & Etiket)
                        Etiket = ""
                        Say = 1
                    End If
                Next
            Next
        End If
    Next
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[asitetik]

korhan bey çok teşekkür ederim ilginiz için.