sonra çalışmanıza yeni bir modül ekleyip oraya aşağıdaki kodu ekleyin
VBA sayfasında fonksiyonun ilk satırına tıkladıktan sonra F5 tuşuna basın
dilerim işinize yarar
Not: bu işlemin tek seferlik olacağı varsayıldığından dosyada uzantı değişikliğine gidilmedi
bu haliyle XLSX uzantılı olarak dosyanızı kaydetmeye çalışırsanız fonksiyon kaydedilmez
Sub Kisalt()
Dim DiziLugat() As Variant
Dim DiziLugat2() As Variant
Dim SyfKynk As Worksheet
Dim SyfHdf As Worksheet
Dim SonStr As Long
On Error Resume Next
Set SyfKynk = ThisWorkbook.Worksheets("lugat")
Set SyfHdf = ThisWorkbook.Worksheets("Lugat_2")
SonStr = SyfKynk.Cells(Rows.Count, 1).End(xlUp).Row
DiziLugat = SyfKynk.Range("A1:B" & SonStr)
ReDim DiziLugat2(LBound(DiziLugat) To UBound(DiziLugat), 1 To 2)
For x = LBound(DiziLugat) To UBound(DiziLugat)
VrgulKes = InStrRev(Left(DiziLugat(x, 2), 50), ",") - 1
VrgulKes = IIf(VrgulKes < 1, 50, VrgulKes)
DiziLugat2(x, 1) = DiziLugat(x, 1)
DiziLugat2(x, 2) = Left(DiziLugat(x, 2), VrgulKes)
Next x
SyfHdf.Range("A1").Resize(UBound(DiziLugat2, 1), UBound(DiziLugat2, 2)) = DiziLugat2
MsgBox "bitti"
End Sub
https://resim.accesstr.net/do.php?img=10695