excel formülü vba makro yapmak

[kbeydili]

Merhaba,
=EĞER(GİRİŞ!G4="";"";EĞER(UZUNLUK(GİRİŞ!G4)-UZUNLUK(YERİNEKOY(GİRİŞ!G4;" ";""))=0;PARÇAAL(GİRİŞ!G4;1;2)&YİNELE("*";UZUNLUK(GİRİŞ!G4)-2);EĞER(UZUNLUK(GİRİŞ!G4)-UZUNLUK(YERİNEKOY(GİRİŞ!G4;" ";""))=1;PARÇAAL(GİRİŞ!G4;1;2)&YİNELE("*";UZUNLUK(PARÇAAL(GİRİŞ!G4;1;BUL(" ";GİRİŞ!G4)-1))-2)&" "&PARÇAAL(PARÇAAL(GİRİŞ!G4;BUL(" ";GİRİŞ!G4)+1;UZUNLUK(GİRİŞ!G4)-BUL(" ";GİRİŞ!G4));1;2)&YİNELE("*";UZUNLUK(PARÇAAL(GİRİŞ!G4;BUL(" ";GİRİŞ!G4)+1;UZUNLUK(GİRİŞ!G4)-BUL(" ";GİRİŞ!G4)))-2);EĞER(UZUNLUK(GİRİŞ!G4)-UZUNLUK(YERİNEKOY(GİRİŞ!G4;" ";""))=2;PARÇAAL(GİRİŞ!G4;1;2)&YİNELE("*";UZUNLUK(PARÇAAL(GİRİŞ!G4;1;BUL(" ";GİRİŞ!G4)-1))-2)&" "&PARÇAAL(PARÇAAL(GİRİŞ!G4;BUL(" ";GİRİŞ!G4)+1;BUL(" ";GİRİŞ!G4;BUL(" ";GİRİŞ!G4)+1)-BUL(" ";GİRİŞ!G4)-1);1;2)&YİNELE("*";UZUNLUK(PARÇAAL(GİRİŞ!G4;BUL(" ";GİRİŞ!G4)+1;BUL(" ";GİRİŞ!G4;BUL(" ";GİRİŞ!G4)+1)-BUL(" ";GİRİŞ!G4)-1))-2)&" "&PARÇAAL(PARÇAAL(GİRİŞ!G4;BUL(" ";GİRİŞ!G4;BUL(" ";GİRİŞ!G4)+1)+1;UZUNLUK(GİRİŞ!G4)-BUL(" ";GİRİŞ!G4;BUL(" ";GİRİŞ!G4)+1));1;2)&YİNELE("*";UZUNLUK(PARÇAAL(GİRİŞ!G4;BUL(" ";GİRİŞ!G4;BUL(" ";GİRİŞ!G4)+1)+1;UZUNLUK(GİRİŞ!G4)-BUL(" ";GİRİŞ!G4;BUL(" ";GİRİŞ!G4)+1)))-2);))))
formül çok uzun ve dosyayı kasıyor
4 lü maskeleme şeklinde vba makroya nasıl dönüştürebilirim.

[SNNAY]

Deneyiniz; Fonkisyonu =MaskeIsim(G4) şeklinde kullanabilirsiniz

Kod: Tümünü seç

Function MaskeIsim(ByVal tamIsim As String) As String
    Dim parcalar() As String
    Dim i As Integer
    Dim sonuc As String
    Dim kelime As String
    
    ' Boşsa boş dön
    If Len(Trim(tamIsim)) = 0 Then
        MaskeIsim = ""
        Exit Function
    End If

    ' Fazla boşlukları temizle ve parçala
    tamIsim = Application.WorksheetFunction.Trim(tamIsim)
    parcalar = Split(tamIsim, " ")
    
    For i = LBound(parcalar) To UBound(parcalar)
        kelime = parcalar(i)
        If Len(kelime) >= 2 Then
            sonuc = sonuc & Left(kelime, 2) & String(Len(kelime) - 2, "*") & " "
        Else
            sonuc = sonuc & kelime & " "
        End If
    Next i
    
    ' Sondaki boşluğu sil
    MaskeIsim = Trim(sonuc)
End Function