• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Cari hesaplarının ayırt edilmesi

1903emre34@gmail.com

Altın Üye
Katılım
29 Mayıs 2016
Mesajlar
946
Excel Vers. ve Dili
Microsoft Excel 2013 Türkçe
Merhaba arkadaşlar

a1 sütününde aşağıdaki cari hesap yer alıyor (YURTIÇI GRUP DIŞI SATICILAR TL/ABC LTD.ŞTİ. ) ; benim istediğim b1 sütününde yer almasının istediğim ABC LTD ŞTİ olacak şekilde aşağıdaki kod nasıl değişiklik yapabiliriz


YURTIÇI GRUP DIŞI SATICILAR TL/ABC LTD.ŞTİ.

(Makro kodu çalıştırdığı zaman b1 sütününde TL/ABC LTD ŞTİ yer alıyor)

Kod:
 Sub ayır()
For i = 3 To Cells(Rows.Count, "A").End(3).Row
boşluk = Len(Cells(i, "A")) - Len(Replace(Cells(i, "A"), " ", ""))
If boşluk = 1 Then
Cells(i, "C") = Left(Cells(i, "A"), WorksheetFunction.Find(" ", Cells(i, "A")) - 1)
Cells(i, "D") = Replace(Cells(i, "A"), Cells(i, "C"), "")
ElseIf boşluk > 1 Then
böl = Int(boşluk / 2)
a = Split(Cells(i, "A"), " ")(böl)
Cells(i, "C") = Left(Cells(i, "A"), WorksheetFunction.Find(a, Cells(i, "A")) - 1)
Cells(i, "D") = Replace(Cells(i, "A"), Cells(i, "C"), "")
Else
Cells(i, "C") = Cells(i, "A")
End If
Next
End Sub
 
Aşağıdaki gibi deneyiniz:

Kod:
Sub ayır()
For i = 3 To Cells(Rows.Count, "A").End(3).Row
    If Len(Cells(i, "A")) <> Len(Replace(Cells(i, "A"), "/", "")) Then
        Cells(i, "C") = Trim(Left(Cells(i, "A"), WorksheetFunction.Find("/", Cells(i, "A")) - 1))
        Cells(i, "D") = Trim(Replace(Replace(Cells(i, "A"), Cells(i, "C"), ""), "/", ""))
    Else
        boşluk = Len(Cells(i, "A")) - Len(Replace(Cells(i, "A"), " ", ""))
        If boşluk = 1 Then
            Cells(i, "C") = Left(Cells(i, "A"), WorksheetFunction.Find(" ", Cells(i, "A")) - 1)
            Cells(i, "D") = Replace(Cells(i, "A"), Cells(i, "C"), "")
        ElseIf boşluk > 1 Then
            böl = Int(boşluk / 2)
            a = Split(Cells(i, "A"), " ")(böl)
            Cells(i, "C") = Trim(Left(Cells(i, "A"), WorksheetFunction.Find(a, Cells(i, "A")) - 1))
            Cells(i, "D") = Trim(Replace(Cells(i, "A"), Cells(i, "C"), ""))
        Else
        Cells(i, "C") = Cells(i, "A")
        End If
    End If
Next
End Sub
 
Geri
Üst