Anahtar Kelimeleri Metin İçerisinde Silme

[bilal5412]

Merhaba arkadaşlar,

Ekteki dosyada bulunan çalışmam, sayfa1 ve sayfa2 den oluşmaktadır. Yapmak istediğim ise, Sayfa2 deki A sütunundaki anahtar kelimeleri, sayfa1 deki A sütunundaki metin içerisinden silmek ve sayfa1 deki B sutunundaki gibi son halini almasını istiyorum.

Ek bilgi:

*Sayfa1 ve sayfa2 deki A sütununda boşluk yoktur. Veri sayısı sınırsızdır.
*Sayfa2 deki A sütununda belirtilen anahtar kelimelerden bir veya birden fazlası sayfa1 deki A sutunundaki metin içerinde yer alabilir.
*Ayrıca Sayfa2 deki anahtar kelimeleri, sayfa1 de A sütununda bulup metin içerisinde bu anahtar kelimleri kalın kırmızı ile gösterebilir misiniz.

Yardımlarınızı rica eder, ilgilenenler için teşekkür ederim.



https://drive.google.com/file/d/0B3wJKQcxKCV4cDNFOVlHaXFOcVk/view?usp=sharing

 

[Emir Hüseyin Çoban]

. . .

A sütunundan kelimeleri hem silmek hemde kırmızı ile belirtmek istemişsiniz ???

. . .

 

[PLİNT]

Merhaba arkadaşlar,

Ekteki dosyada bulunan çalışmam, sayfa1 ve sayfa2 den oluşmaktadır. Yapmak istediğim ise, Sayfa2 deki A sütunundaki anahtar kelimeleri, sayfa1 deki A sütunundaki metin içerisinden silmek ve sayfa1 deki B sutunundaki gibi son halini almasını istiyorum.

Ek bilgi:
*Sayfa1 ve sayfa2 deki A sütununda boşluk yoktur. Veri sayısı sınırsızdır.
*Sayfa2 deki A sütununda belirtilen anahtar kelimelerden bir veya birden fazlası sayfa1 deki A sutunundaki metin içerinde yer alabilir.
*Ayrıca Sayfa2 deki anahtar kelimeleri, sayfa1 de A sütununda bulup metin içerisinde bu anahtar kelimleri kalın kırmızı ile gösterebilir misiniz.

Yardımlarınızı rica eder, ilgilenenler için teşekkür ederim.

Merhaba
Ek dosyayı inceleyin istediğiniz böylemi?

http://www.upturkey.com/882örnek12.zip

Kodlardaki biçimlendirme yapan mavi bölüm, sütunlardaki verileriniz çok ise yavaşlamaya sebep olacaktır.

[SIZE="2"]'Sayfa2'ye eklenecek butona
Private Sub CommandButton1_Click()
Sheets("Sayfa1").Select
Sheets("Sayfa1").Columns("A:A").Copy Sheets("Sayfa1").Columns("B:B")

For a = 2 To Cells(Rows.Count, 1).End(3).Row
Sheets("Sayfa1").Columns("B").Replace What:=Trim(Cells(a, 1).Value), Replacement:="", SearchOrder:=xlByColumns, MatchCase:=True
Sheets("Sayfa1").Columns("B").Replace What:="- ", Replacement:="-"
[COLOR="Blue"]With Sheets("Sayfa1").Columns("A")
    Set c = .Find(Trim(Cells(a, 1).Value), Lookat:=xlPart)
    If Not c Is Nothing Then
bul = c.Address
        Do
With c.Characters(InStr(c.Value, Trim(Cells(a, 1).Value)), Len(Trim(Cells(a, 1).Value)))
.Font.ColorIndex = 3
.Font.FontStyle = "Kalın"
End With
 Set c = .FindNext(c)
If c Is Nothing Then Exit Do
        Loop While Not c Is Nothing And c.Address <> bul
    End If
End With[/COLOR]
Next
End Sub[/SIZE]

 

[bilal5412]

. . .

A sütunundan kelimeleri hem silmek hemde kırmızı ile belirtmek istemişsiniz ???

. . .

Hüseyin Bey,

A sütunundaki veriler sabit kalıp bu veriler içinde silinecek olanlar kırmızı ile belirtilip, A sütununda silinen kelimelerin çıkarılmış hali B sütununa yazdırılacak.

 

[bilal5412]

Merhaba
Ek dosyayı inceleyin istediğiniz böylemi?

http://www.upturkey.com/882örnek12.zip

Kodlardaki biçimlendirme yapan mavi bölüm, sütunlardaki verileriniz çok ise yavaşlamaya sebep olacaktır.

[SIZE="2"]'Sayfa2'ye eklenecek butona
Private Sub CommandButton1_Click()
Sheets("Sayfa1").Select
Sheets("Sayfa1").Columns("A:A").Copy Sheets("Sayfa1").Columns("B:B")

For a = 2 To Cells(Rows.Count, 1).End(3).Row
Sheets("Sayfa1").Columns("B").Replace What:=Trim(Cells(a, 1).Value), Replacement:="", SearchOrder:=xlByColumns, MatchCase:=True
Sheets("Sayfa1").Columns("B").Replace What:="- ", Replacement:="-"
[COLOR="Blue"]With Sheets("Sayfa1").Columns("A")
    Set c = .Find(Trim(Cells(a, 1).Value), Lookat:=xlPart)
    If Not c Is Nothing Then
bul = c.Address
        Do
With c.Characters(InStr(c.Value, Trim(Cells(a, 1).Value)), Len(Trim(Cells(a, 1).Value)))
.Font.ColorIndex = 3
.Font.FontStyle = "Kalın"
End With
 Set c = .FindNext(c)
If c Is Nothing Then Exit Do
        Loop While Not c Is Nothing And c.Address <> bul
    End If
End With[/COLOR]
Next
End Sub[/SIZE]

Merhaba, ilginiz için teşekkürler. Ekteki dosyayı indiremiyorum. Tekrar bakabilir misiniz.

 

[PLİNT]

Aşağıdaki adresini deneyin.
http://s6.dosya.tc/server3/yzpjrn/ornek1.zip.html