• DİKKAT

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

Makroyu hızlandırmak

M

metin_0606

Katılım
1 Ağustos 2019
Mesajlar
839
Excel Vers. ve Dili
Türkçe excel 2016
İngilizce excel 2016
Sub asciikod()
For i = 2 To Cells(Rows.Count, "A").End(3).Row
If Cells(i, "A") <> "" Then
Cells(i, "A") = Replace(Cells(i, "A"), Chr(13), "")
End If
Next
End Sub. Bu makroyu ASCII kodu 13 olan boşluğu siliyorum .Ancak 5000 satırlık veride çok yavaş çalışıyor. Kodu revize ederek hizlandirmamiz mümkünmü acaba
 
Merhaba,
Aşağıdaki kodu dener misiniz?

Kod: 
Sub Makro1()

    Application.DisplayAlerts = False
    Columns("A:A").Replace What:=Chr(13), Replacement:="", LookAt:=xlPart
    Application.DisplayAlerts = True
    
End Sub
 
Necdet' Alıntı:
Merhaba,
Aşağıdaki kodu dener misiniz?

Kod: 
Sub Makro1()

    Application.DisplayAlerts = False
    Columns("A:A").Replace What:=Chr(13), Replacement:="", LookAt:=xlPart
    Application.DisplayAlerts = True
   
End Sub
Genişletmek için tıkla ...
Paylaştığım makrodan daha uzun sürede işlem yaptı Necdet bey
 
Allah allah döngüden daha hızlı olmasını beklerdim, bende şaşırdım.
E o zaman yapacak bir şey yok.
Peki bul ve değiştiri makro değil Ctrl+H ile yapsanız hız açısından bir farklılık olur mu ki? denediniz mi?
 
Necdet' Alıntı:
Allah allah döngüden daha hızlı olmasını beklerdim, bende şaşırdım.
E o zaman yapacak bir şey yok.
Peki bul ve değiştiri makro değil Ctrl+H ile yapsanız hız açısından bir farklılık olur mu ki? denediniz mi?
Genişletmek için tıkla ...
O aradaki boşluk kısım boşluk değilde ASCII demişti forumdan Yusuf 44 bey o yüzden cntrl H işimi görmüyor Necdet bey
 
Şu kodu deneyebilir misiniz?

Option Explicit

Sub asciikod()
Application.ScreenUpdating = False
Dim rng, c As Range
Dim irow As Long
irow = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("a2:a" & irow)

For Each c In rng
If InStr(1, c, Chr(13)) Then
c = Application.Substitute(c, Chr(13), "")
End If
Next

Application.ScreenUpdating = True
End Sub
 
Kod: 
Option Explicit

Sub asciikod()
Application.ScreenUpdating = False
Dim rng, c As Range
Dim irow As Long
irow = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("a2:a" & irow)

For Each c In rng
    If InStr(1, c, Chr(13)) Then
        c = Application.Substitute(c, Chr(13), "")
    End If
Next

Application.ScreenUpdating = True
End Sub
 
genesis_vision' Alıntı:
Kod: 
Option Explicit

Sub asciikod()
Application.ScreenUpdating = False
Dim rng, c As Range
Dim irow As Long
irow = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("a2:a" & irow)

For Each c In rng
    If InStr(1, c, Chr(13)) Then
        c = Application.Substitute(c, Chr(13), "")
    End If
Next

Application.ScreenUpdating = True
End Sub
Genişletmek için tıkla ...
Maalesef süre olarak değişen bir şey olmadi
 
metin_0606' Alıntı:
O aradaki boşluk kısım boşluk değilde ASCII demişti forumdan Yusuf 44 bey o yüzden cntrl H işimi görmüyor Necdet bey
Genişletmek için tıkla ...

Görür görürr.

ilgili karakteri koplayıp değiştirme yaptığınız yere yapıştırırsınız olur biter. Kopyalamayı Ctrl+Insert, yapıştırmayı Shift+Insert tuşları ile yaparsınız.
Çözüm her zaman vardır.
 
Necdet' Alıntı:
Görür görürr.

ilgili karakteri koplayıp değiştirme yaptığınız yere yapıştırırsınız olur biter. Kopyalamayı Ctrl+Insert, yapıştırmayı Shift+Insert tuşları ile yaparsınız.
Çözüm her zaman vardır.
Genişletmek için tıkla ...
Makrolu çözüm tercihimdir
 
Alternatif;

Hız olarak avantaj sağlayabilir.

A sütunu için;
C++: 
Option Explicit

Sub Ascii_Bosluk_Sil()
    Dim Veri As Variant, Son As Long, X As Long, Zaman As Double

    Zaman = Timer

    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A3:A" & Son).Value

    ReDim Liste(1 To UBound(Veri), 1 To 1)

    For X = 1 To UBound(Veri)
        Liste(X, 1) = Trim(Replace(Veri(X, 1), Chr(13), ""))
    Next

    Range("A3").Resize(X - 1) = Liste

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub


A-P sütun aralığı için;
C++: 
Option Explicit

Sub Ascii_Bosluk_Sil()
    Dim Veri As Variant, Son As Long, X As Long, Y As Byte, Zaman As Double

    Zaman = Timer

    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A3:P" & Son).Value

    ReDim Liste(1 To UBound(Veri), 1 To 15)

    For X = 1 To UBound(Veri)
        For Y = 1 To 15
            Liste(X, Y) = Trim(Replace(Veri(X, Y), Chr(13), ""))
        Next
    Next

    Range("A3").Resize(X - 1, 15) = Liste

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub
 
Korhan Ayhan' Alıntı:
Alternatif;

Hız olarak avantaj sağlayabilir.

A sütunu için;
C++: 
Option Explicit

Sub Ascii_Bosluk_Sil()
    Dim Veri As Variant, Son As Long, X As Long, Zaman As Double

    Zaman = Timer

    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A3:A" & Son).Value

    ReDim Liste(1 To UBound(Veri), 1 To 1)

    For X = 1 To UBound(Veri)
        Liste(X, 1) = Replace(Veri(X, 1), Chr(13), "")
    Next

    Range("A3").Resize(X - 1) = Liste

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub


A-P sütun aralığı için;
C++: 
Option Explicit

Sub Ascii_Bosluk_Sil()
    Dim Veri As Variant, Son As Long, X As Long, Y As Byte, Zaman As Double

    Zaman = Timer

    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A3:P" & Son).Value

    ReDim Liste(1 To UBound(Veri), 1 To 15)

    For X = 1 To UBound(Veri)
        For Y = 1 To 15
            Liste(X, Y) = Replace(Veri(X, Y), Chr(13), "")
        Next
    Next

    Range("A3").Resize(X - 1, 15) = Liste

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub
Genişletmek için tıkla ...
Tşkler Korhan bey tam istediğim gibi
 
İşlem süresi nedir? Ne kadar avantaj sağladı?
 
Üstteki mesajımı revize ettim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst