• DİKKAT

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

Toplu Bul ve Değiştir

N

nanotech3485

Katılım
2 Mayıs 2021
Mesajlar
56
Excel Vers. ve Dili
Excel 2016 - TR
Merhaba arkadaşlar;

Elimde "Job Title" sütununda binlerce satır veri var. Toplu bir şekilde bul ve değiştir işlemi yaptırmak istiyorum. Alttaki resimde görüldüğü gibi Find ve Replace Sütunlarına bulunacak ve değiştirilecek kelime listesini oluşturacağım. Başlat butonuna tıkladığımda ise Bul ve Değiştir yapmasını istiyorum. Her gün bu şekilde binlerce veriyle tek tek uğraşıp çok zaman kaybediyorum. Eğer böyle bir makro yapılabilirse işim çok rahatlayacak. Yardımcı olabilmeniz mümkün müdür acaba?

 
Merhaba.

Örnek dosya hazırlayıp dosya.tc gibi bir paylaşım sitesine ekleyin.
 
Aşağıdaki kod ile yapabilirsiniz.
Kod: 
Sub test()
    Dim Bak As Long
    For Bak = 2 To Cells(Rows.Count, "D").End(xlUp).Row
        Range("A:A").Replace what:=Cells(Bak, "C"), replacement:=Cells(Bak, "D"), lookat:=xlPart
    Next
msgbox "İşlem tamamlandı."
End Sub
 
Son düzenleme:
Muzaffer Ali' Alıntı:
Aşağıdaki kod ile yapabilirsiniz.
Kod: 
Sub test()
    Dim Bak As Long
    For Bak = 2 To Cells(Rows.Count, "D").End(xlUp).Row
        Range("A:A").Replace what:=Cells(Bak, "C"), replacement:=Cells(Bak, "D"), lookat:=xlPart
    Next
End Sub
Genişletmek için tıkla ...

Hocam kod çalıştı çok teşekkürler. Acaba işlemin bittiğine dair bir mesaj nasıl çıkartabiliriz acaba? Malum binlerce satır var. Bunu da ekleyebilir misiniz acaba?
 
Oluşturduğunuz kodların en altındaki End Sub satırından hemen önce aşağıdaki satırı ilave edebilirsiniz.
MsgBox "İşlem tamamlandı"
 
Tekrar merhabalar, yukarıda ki makro da onbinlerce satır işlem yapılıyor. Acaba bu makroya bir progress bar nasıl eklenebilir, yardımcı olabilir misiniz? Makro uzun saatler çalıştığı için işin ne kadarlık kısmını bitirdiğini % olarak görme şansım var mıdır? Çok teşekkürler.

Kod: 
Sub test()
Dim Bak As Long
    For Bak = 2 To Cells(Rows.Count, "D").End(xlUp).Row
        Range("A:A").Replace what:=Cells(Bak, "C"), replacement:=Cells(Bak, "D"), lookat:=xlPart
Next
msgbox "İşlem tamamlandı."
End Sub


Örnek dosya yolu: https://s2.dosya.tc/server17/cl9ibp/toplu-bul-degistir.xlsx.html
 
Merhaba.
Kod: 
Private Sub CommandButton1_Click()
    Dim Bak As Long
    Dim Say As Long
    Say = Cells(Rows.Count, "D").End(xlUp).Row
    ProgressBar1.Min = 1
    ProgressBar1.Max = Say
    ProgressBar1.Value = 1
    For Bak = 2 To Say
        ProgressBar1.Value = Bak
        ProgressBar1.Refresh
        Range("A:A").Replace what:=Cells(Bak, "C"), replacement:=Cells(Bak, "D"), lookat:=xlPart
    Next
    MsgBox "İşlem tamamlandı."
End Sub
 
Muzaffer Ali' Alıntı:
Merhaba.
Kod: 
Private Sub CommandButton1_Click()
    Dim Bak As Long
    Dim Say As Long
    Say = Cells(Rows.Count, "D").End(xlUp).Row
    ProgressBar1.Min = 1
    ProgressBar1.Max = Say
    ProgressBar1.Value = 1
    For Bak = 2 To Say
        ProgressBar1.Value = Bak
        ProgressBar1.Refresh
        Range("A:A").Replace what:=Cells(Bak, "C"), replacement:=Cells(Bak, "D"), lookat:=xlPart
    Next
    MsgBox "İşlem tamamlandı."
End Sub
Genişletmek için tıkla ...


Merhaba hocam, kodu ekledim 1 buton oluşturdum. Ama çalıştıramadım. Yardımcı olabilir misiniz rica etsem . Teşekkür ederim.

Dosya linki: https://s7.dosya.tc/server22/ahmbdz/toplu-degistir.xlsm.html
 
Muzaffer Bey merhaba, yardımlarınız için teşekkürler şimdi butona tıkladıktan sonra makro çalışmaya başladı. Şu an hala çalışıyor ama ekranda bir işlemin ne kadarlık kısmının yapıldığına dair bir yüzde penceresi gelmedi maalesef. Hata mı yapıyorum acaba
 
Formun üzerinde ProgressBar var ilerleme oradan takip ediliyor.
VBA kısmından kontrol edin formun üzerinde ProgressBar yok mu?
 
Butona tıkladıktan sonra VBA penceresi açılıyor kodlar görünüyor ama herhangi bir ProgressBar göremiyorum. Çok az veri olmasına rağmen excel donuyor hocam.
 
Formun kodlarını silin, yerine aşağıdakileri kopyalayın.

Kod: 
Private Sub UserForm_Activate()
    Dim Bak As Long
    Dim SayA As Long
    Dim SayD As Long
    SayA = Cells(Rows.Count, "A").End(xlUp).Row
    SayD = Cells(Rows.Count, "D").End(xlUp).Row
    ProgressBar1.Min = 1
    ProgressBar1.Max = SayD
    ProgressBar1.Value = 1
    DoEvents
    For Bak = 2 To SayD
        ProgressBar1.Value = Bak
        Range("A1:A" & SayA).Replace what:=Cells(Bak, "C"), replacement:=Cells(Bak, "D"), lookat:=xlPart
        Label1.Caption = FormatNumber(Bak / (SayD / 100), 2)
        DoEvents
    Next
    Unload Me
    MsgBox "İşlem tamamlandı."
End Sub
 
Hocam dediğiniz gibi yaptım ama excel kilitleniyor. Dosyayı göndereyim tekrardan size. Umarım hata yapmamışımdır.
 

Ekli dosyalar

Formdaki ProgressBarı silmişsiniz. Yada ProgressBar referansınız yok.
Bu yüzden hata alıyorsunuz.
Sadece Labelde % gösterecek şekilde yeniden kodları düzenledim.

Kod: 
Private Sub UserForm_Activate()
    Dim Bak As Long
    Dim SayA As Long
    Dim SayD As Long
    SayA = Cells(Rows.Count, "A").End(xlUp).Row
    SayD = Cells(Rows.Count, "D").End(xlUp).Row
    For Bak = 2 To SayD
        Range("A1:A" & SayA).Replace what:=Cells(Bak, "C"), replacement:=Cells(Bak, "D"), lookat:=xlPart
        Label1.Caption ="Tamamlanan: " & FormatNumber(Bak / (SayD / 100), 2)
        DoEvents
    Next
    Unload Me
    MsgBox "İşlem tamamlandı."
End Sub
 
Muzaffer Ali' Alıntı:
Formdaki ProgressBarı silmişsiniz. Yada ProgressBar referansınız yok.
Bu yüzden hata alıyorsunuz.
Sadece Labelde % gösterecek şekilde yeniden kodları düzenledim.

Kod: 
Private Sub UserForm_Activate()
    Dim Bak As Long
    Dim SayA As Long
    Dim SayD As Long
    SayA = Cells(Rows.Count, "A").End(xlUp).Row
    SayD = Cells(Rows.Count, "D").End(xlUp).Row
    For Bak = 2 To SayD
        Range("A1:A" & SayA).Replace what:=Cells(Bak, "C"), replacement:=Cells(Bak, "D"), lookat:=xlPart
        Label1.Caption ="Tamamlanan: " & FormatNumber(Bak / (SayD / 100), 2)
        DoEvents
    Next
    Unload Me
    MsgBox "İşlem tamamlandı."
End Sub
Genişletmek için tıkla ...


Muzaffer Hocam çalıştı çok sevindim. Emeğinize sağlık.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst