Toplu Bul ve Değiştir

[nanotech3485]

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?

 

[Muzaffer Ali]

Merhaba.

Örnek dosya hazırlayıp dosya.tc gibi bir paylaşım sitesine ekleyin.

 

[nanotech3485]

Merhaba.

Örnek dosya hazırlayıp dosya.tc gibi bir paylaşım sitesine ekleyin.

Uyarınız için teşekkürler. Örnek dosya aşağıdaki gibidir.

toplu-bul-degistir.xlsx dosyasını indir - download

toplu-bul-degistir.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s2.dosya.tc

 

[Muzaffer Ali]

Aşağıdaki kod ile yapabilirsiniz.

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

 

[nanotech3485]

Aşağıdaki kod ile yapabilirsiniz.

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

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?

 

[ÖmerFaruk]

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ı"

 

[Muzaffer Ali]

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?

Ekledim.
Bir mesaj gösterecek kadar bilginiz yoksa biraz çaba göstermelisiniz. Kolay gelsin.

 

[nanotech3485]

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ı"

Teşekkürler hocam.

 

[nanotech3485]

Ekledim.
Bir mesaj gösterecek kadar bilginiz yoksa biraz çaba göstermelisiniz. Kolay gelsin.

Hocam teşekkürler. Gerçekten hiç bir bilgim yok. Elinize sağlık tekrardan

 

[nanotech3485]

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.

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

 

[Muzaffer Ali]

Merhaba.

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

 

[nanotech3485]

Merhaba.

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

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 Ali]

Dosyanız ekte.

toplu-degistir.xlsm dosyasını indir - download

toplu-degistir.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s2.dosya.tc

 

[nanotech3485]

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

 

[Muzaffer Ali]

Formun üzerinde ProgressBar var ilerleme oradan takip ediliyor.
VBA kısmından kontrol edin formun üzerinde ProgressBar yok mu?

 

[nanotech3485]

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.

 

[Muzaffer Ali]

Formun kodlarını silin, yerine aşağıdakileri kopyalayın.

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

 

[nanotech3485]

Hocam dediğiniz gibi yaptım ama excel kilitleniyor. Dosyayı göndereyim tekrardan size. Umarım hata yapmamışımdır.

 

[Muzaffer Ali]

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.

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

 

[nanotech3485]

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.

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 Hocam çalıştı çok sevindim. Emeğinize sağlık.