Parçaal formülünü makroya çevirmek

Katılım
27 Mayıs 2010
Mesajlar
527
Excel Vers. ve Dili
Excel 2003 Turkçe
Merhaba,
Aşağıdaki makroyu çalıştırdığımda uygulamsı uzun sürüyor. Hücreleri dolduruyor gibi bazı şeyler bildiriyor. Daha hızlı çalışabilmesi için neyi düzeltmem gerekiyor. Yardımlarınızı rica ediyorum.
Sub test_4()
With Range("e2:e10000" & Cells(Rows.Count, 2).End(xlUp).Row)
.Formula = "=IFERROR(MID(RC[-1],FIND("":"",RC[-1])+1,FIND(""KDVSI"",RC[-1])-FIND("":"",RC[-1])-2),"""")"
.Value = .Value
End With

End Sub
 

Cengiz Demir

Altın Üye
Katılım
29 Haziran 2018
Mesajlar
605
Excel Vers. ve Dili
Office 365 TR (32 Bit)
Altın Üyelik Bitiş Tarihi
05-04-2025
Örnek dosya eklerseniz daha hızlı sonuç alırsınız. :)
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,712
Excel Vers. ve Dili
Excel 2019 Türkçe
Bu şekilde deneyin.
Kod:
Sub test_4()
    Application.Calculation = xlManual
    With Range("e2:e5" & Cells(Rows.Count, 2).End(xlUp).Row)
        .Formula = "=IFERROR(MID(RC[-1],FIND("":"",RC[-1])+1,FIND(""KDVSI"",RC[-1])-FIND("":"",RC[-1])-2),"""")"
        .Value = .Value
    End With
    Application.Calculation = xlAutomatic
End Sub
 

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,647
Excel Vers. ve Dili
Pro Plus 2021
Kod:
Sub test_4()
    For Each cell In Range("d2:d" & Cells(Rows.Count, 4).End(xlUp).Row)
        With cell
            If InStr(.Value, ":") > 0 Then
                .Offset(, 1).Value = Split(Split(.Value, ":")(1), " ")(0)
            End If
        End With
    Next cell
End Sub
 
Katılım
27 Mayıs 2010
Mesajlar
527
Excel Vers. ve Dili
Excel 2003 Turkçe
Bu şekilde deneyin.
Kod:
Sub test_4()
    Application.Calculation = xlManual
    With Range("e2:e5" & Cells(Rows.Count, 2).End(xlUp).Row)
        .Formula = "=IFERROR(MID(RC[-1],FIND("":"",RC[-1])+1,FIND(""KDVSI"",RC[-1])-FIND("":"",RC[-1])-2),"""")"
        .Value = .Value
    End With
    Application.Calculation = xlAutomatic
End Sub
Çok teşekkür ederim emeğinize sağlık
 
Katılım
27 Mayıs 2010
Mesajlar
527
Excel Vers. ve Dili
Excel 2003 Turkçe
Kod:
Sub test_4()
    For Each cell In Range("d2:d" & Cells(Rows.Count, 4).End(xlUp).Row)
        With cell
            If InStr(.Value, ":") > 0 Then
                .Offset(, 1).Value = Split(Split(.Value, ":")(1), " ")(0)
            End If
        End With
    Next cell
End Sub
Çok teşekkür ederim emeğinize sağlık
 
Üst