Excel 2007'deki bir sütunda birden çok sözcük bulun ve değiştirin


1
Sub xLator2()
Dim s1 As Worksheet, s2 As Worksheet
Dim N As Long, i As Long
Dim from(), too()
Set s1 = Sheets("Sheet1") '   contains the data
Set s2 = Sheets("Sheet2") '   contains the translation table

s2.Activate

N = Cells(Rows.Count, 1).End(xlUp).Row
ReDim from(1 To N)
ReDim too(1 To N)
For i = 1 To N
    from(i) = Cells(i, 1).Value
    too(i) = Cells(i, 2).Value
Next i

s1.Activate

For i = LBound(from) To UBound(from)
    Cells.Replace What:=from(i), Replacement:=too(i)
Next i
End Sub

Aşağıdaki kodu kullanarak birden fazla sözcük bulmak ve değiştirmek için yukarıdaki kodu kullanıyorum ("Sütun A Sayfa1" de "Sütun B Sayfa 2" deki kelimelerle):

https://docs.google.com/spreadsheets/d/15TRLccDr_EAR8s78u-WGSkGpAecBf42_lhRkjCev_WE/edit?usp=sharing

Ancak bunu başka bir sayfada (aşağıda belirtildiği gibi) başka bir veri için uyguladığımda kod başarısız oluyor, yani sayfa 1'de çarpık kelimeler alıyorum:

https://docs.google.com/spreadsheets/d/14ba9pQDjMPWJd4YFpGffhtVcHxml0LdUUVQ0prrOEUY/edit?usp=sharing

Lütfen "A Sütun1 Sayfadaki" kelimeleri "Sütun B Sayfa 2" deki sözcüklerle değiştirebilmem için bana yardım et

Not: Yukarıdaki bağlantılar google elektronik tablosundan verilmiştir, ancak Excel 2007 sayfasında sorun yaşıyorum.

VBA’da iyi olmadığım için tüm kodu gözden geçirerek bana yardım etmenizi rica ediyorum.

Yanıtlar:


0

İstediğiniz şeyin yalnızca bir kez değiştirme yapmak olduğunu ve bir değiştirme yapıldıktan sonra diğer kuralları durdurmak olduğunu farz ediyorum. İkinci sayfanızı örnek alarak, satır 12 "ancak" "ancak" olarak çevrilmeli ve "ancak" "hoyouever" e çevrilmemesi için diğer kuralları durdurmalı (kural # 17 olarak "biz" kelimesini "size" çevirir) ).

Geçici bir çözüm, her şeyi önce bir ara sembole, ikinci aşamada ise ara sembollerden istenen yerine çevirmeye çalışmaktır. Kodunuzu aşağıdaki gibi biraz değiştirmek işe yarayacaktır:

Sub xLator2()
Dim s1 As Worksheet, s2 As Worksheet
Dim N As Long, i As Long
Dim from(), too()
Set s1 = Sheets("Sheet1") '   contains the data
Set s2 = Sheets("Sheet2") '   contains the translation table

s2.Activate

N = Cells(Rows.Count, 1).End(xlUp).Row
ReDim from(1 To N)
ReDim too(1 To N)
For i = 1 To N
    from(i) = Cells(i, 1).Value
    too(i) = Cells(i, 2).Value
Next i

s1.Activate

' -------------- Modification starts here --------------------------
' Replace from from(i) to __MYREPLACEMENTi__  (where i is the counter)
For i = LBound(from) To UBound(from)
    Cells.Replace What:=from(i), Replacement:="__MYREPLACEMENT" + Str(i) + "__"
Next i
' Replace from __MYREPLACEMENTi__ to too(i)  (where i is the counter)
For i = LBound(from) To UBound(from)
    Cells.Replace What:="__MYREPLACEMENT" + Str(i) + "__", Replacement:=too(i)
Next i
' -------------- Modification ends here --------------------------
End Sub

Sevgili Kenneth, yukarıda belirtilen kod 20 sıraya kadar çalışıyor: docs.google.com/spreadsheets/d/… Ancak yine çalışmaz: docs.google.com/spreadsheets/d/… toplam 101 satır içeriyor. Aynı anda yüzlerce veya binlerce satır için işe yarayan bir şey sağlayabilir misiniz?
Sidharth

Yanıtladığınızda, lütfen aynı kodu kopyalayabilmem için tüm kodu verin.
Sidharth

Cevap bekliyorum
Sidharth
Sitemizi kullandığınızda şunları okuyup anladığınızı kabul etmiş olursunuz: Çerez Politikası ve Gizlilik Politikası.
Licensed under cc by-sa 3.0 with attribution required.