Yerinekoy ve Türkçe karakterleri İngilizce yapma

  • Konuyu başlatan Konuyu başlatan PriveT
  • Başlangıç tarihi Başlangıç tarihi
PriveT

PriveT

İlyas PINAROĞLU

Excel Versiyonu
Excel 2016
Excel Sürümü
64 Bit
Excel Dili
Türkçe
Makro üstadlarım merhaba,
Sizden bir makro rica ediyorum.

Bu Makro:
A sütunundaki veriyi (A3 hücresi itibariyle) alıp;
- tamamı küçük harf
- aradaki boşluklar yerine nokta
- Türkçe karakterler yerine ingilizce karakterler
olarak düzenlenip G sütununa (G3 hücresi itibariyle) kopyalanacak.

Ayrıca A sütunundaki verilerin (A3 hücresi itibariyle) ilk kelimesini alıp;
- tamamını küçük harf yapıp sonuna 3 basamaklı rastgele bir rakam eklip, H sütununa (H3 hücresi itibariyle) kopyalanacak.

Örnek dosyada olmasını istediğim şeklini gösterdim.

Yardımcı olursanız sevinirim.
İyi günler.
 
GSS (Genel Sağlık Sigortası) Kesenek Txt Belge Hazırlama Makrosu
Excel Kullanarak Otomatik Mail Gönderme

Ekli dosyalar

Tarihe göre sırala Oylamaya göre sırala
Formül ile çözüm yapılabilir....

Örnek formül ( A3 hücresinde ki değeri istediğiniz şekile çevirir)

[REPLYANDTHANKS]
Kod: 
=YERİNEKOY(YERİNEKOY(YERİNEKOY(YERİNEKOY(YERİNEKOY(YERİNEKOY(YERİNEKOY(KÜÇÜKHARF(A3);" ";".");"ç";"c");"ğ";"g");"ı";"i");"ö";"o");"ş";"s");"ü";"u")
[/REPLYANDTHANKS]
 
Oyla 0 Olumsuz oyla
cakarem' Alıntı:
Formül ile çözüm yapılabilir....

Örnek formül ( A3 hücresinde ki değeri istediğiniz şekile çevirir)

[Gizlenmiş içerik]
Genişletmek için tıklayın ...
Çözüm için teşekkürler.
Ben de bu şekilde yapıyorum. H3 için de =PARÇAAL(G3;1;BUL(".";G3)-1)&RASTGELEARADA(100;999) kullanıyorum.
Ama bunların MAKRO ile yapılışını merak ettiğim için böyle bir istekte bulundum.
 
Oyla 0 Olumsuz oyla
Aşağıdaki makro kodunu deneyiniz...

[REPLYANDTHANKS]
Kod: 
Private Sub CommandButton1_Click()


For i = 2 To Sayfa1.Range("a65536").End(3).Row

    Sayfa1.Cells(i, 2) = Replace(Replace(Replace(Replace(Replace(Replace(Replace(LCase(Sayfa1.Cells(i, 1)), " ", "."), "ç", "c"), "ğ", "g"), "ı", "i"), "ö", "o"), "ş", "s"), "ü", "u")

Next i

End Sub
[/REPLYANDTHANKS]
 
Oyla 0 Olumsuz oyla
Ekli dosyayı inceleyiniz...

İlgili kod yapısı:

[REPLYANDTHANKS]
Kod: 
Private Sub CommandButton1_Click()


For i = 3 To Sayfa1.Range("a65536").End(3).Row

tekrar::

    deger = Round(999 * Rnd)

    If Not Len(deger) = 3 Then GoTo tekrar

    Sayfa1.Cells(i, 8) = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(LCase(Sayfa1.Cells(i, 1)), " ", "."), "ç", "c"), "ğ", "g"), "ı", "i"), "ö", "o"), "ş", "s"), "ü", "u"), "İ", "i") & deger

Next i

End Sub
[/REPLYANDTHANKS]
 

Ekli dosyalar

Oyla 0 Olumsuz oyla
PriveT' Alıntı:
A sütunundaki verilerin (A3 hücresi itibariyle) ilk kelimesini alıp;
- tamamını küçük harf yapıp sonuna 3 basamaklı rastgele bir rakam eklip, H sütununa (H3 hücresi itibariyle) kopyalamak.
Genişletmek için tıklayın ...
Yukarıda g sütunu ile ilgili bir durumdan bahsetmemişsiniz :) Açıklamayı tam okumamışım. İlk kelime demişsiniz. En iyisi siz yapılacak işlemi tekrardan yazınız :)
A sütunundan veri alacak mı?
G sütunundan veri alacak mı?
Sayılar gelmeden önce nokta koyulacak mı?
Ve bunlar hangi şartlar altında gelecek?
 
Oyla 0 Olumsuz oyla
cakarem' Alıntı:
Yukarıda g sütunu ile ilgili bir durumdan bahsetmemişsiniz :) Açıklamayı tam okumamışım. İlk kelime demişsiniz. En iyisi siz yapılacak işlemi tekrardan yazınız :)
A sütunundan veri alacak mı?
G sütunundan veri alacak mı?
Sayılar gelmeden önce nokta koyulacak mı?
Ve bunlar hangi şartlar altında gelecek?
Genişletmek için tıklayın ...
Burada G sütunundan bahsetmeme sebebim siz bunun çözümünü vermiş H sütununu atlamıştınız.
Birinci yorumumu ve yorumdaki dosyamı inceler misiniz?
 
Oyla 0 Olumsuz oyla
Sayın @PriveT ,
Dalgınlığıma gelmiş :) ilk yazdığınız kısımda gerekli işlemler belirtilmiş :) Dosyayı tekrardan güncelledim...

İlgili kod yapısı:
[REPLYANDTHANKS]
Kod: 
Private Sub CommandButton1_Click()


For i = 3 To Sayfa1.Range("a65536").End(3).Row

    Sayfa1.Cells(i, 7) = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(LCase(Sayfa1.Cells(i, 1)), " ", "."), "ç", "c"), "ğ", "g"), "ı", "i"), "ö", "o"), "ş", "s"), "ü", "u"), "İ", "i")

tekrar::

    deger = Round(999 * Rnd)

    If Not Len(deger) = 3 Then GoTo tekrar

    Sayfa1.Cells(i, 8) = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(LCase(Mid(Sayfa1.Cells(i, 1), 1, InStr(Sayfa1.Cells(i, 1).Value, " ") - 1)), " ", "."), "ç", "c"), "ğ", "g"), "ı", "i"), "ö", "o"), "ş", "s"), "ü", "u"), "İ", "i") & deger

Next i


End Sub
[/REPLYANDTHANKS]

Ekli dosyayı inceleyiniz..
 

Ekli dosyalar

Oyla 0 Olumsuz oyla
Merhaba.
Alternatif olsun.
C: 
Private Sub CommandButton1_Click()
tur = Array("ı", "İ", "ğ", "Ğ", "ü", "Ü", "ş", "Ş", "ö", "Ö", "ç", "Ç")
ing = Array("i", "I", "g", "G", "u", "U", "s", "S", "o", "O", "c", "C")
For sat = 3 To Cells(Rows.Count, 1).End(3).Row
    VBA.Randomize: s = CInt(Int((900 * VBA.Rnd()) + 100)): deg = Cells(sat, 1)
    For k = 0 To 11: deg = Replace(Replace(deg, tur(k), ing(k)), " ", "."): Next
    Cells(sat, 7) = LCase(deg)
    Cells(sat, 8) = Split(LCase(deg), ".")(0) & s
Next
End Sub
 
Oyla 0 Olumsuz oyla
T
Ömer BARAN' Alıntı:
Merhaba.
Alternatif olsun.
C: 
Private Sub CommandButton1_Click()
tur = Array("ı", "İ", "ğ", "Ğ", "ü", "Ü", "ş", "Ş", "ö", "Ö", "ç", "Ç")
ing = Array("i", "I", "g", "G", "u", "U", "s", "S", "o", "O", "c", "C")
For sat = 3 To Cells(Rows.Count, 1).End(3).Row
    VBA.Randomize: s = CInt(Int((900 * VBA.Rnd()) + 100)): deg = Cells(sat, 1)
    For k = 0 To 11: deg = Replace(Replace(deg, tur(k), ing(k)), " ", "."): Next
    Cells(sat, 7) = LCase(deg)
    Cells(sat, 8) = Split(LCase(deg), ".")(0) & s
Next
End Sub
Genişletmek için tıklayın ...
Teşekkürler, emeğinize sağlık. Şehir dışındayım, döner dönmez deneyeceğim.
 
Oyla 0 Olumsuz oyla
Ömer BARAN' Alıntı:
Merhaba.
Alternatif olsun.
C: 
Private Sub CommandButton1_Click()
tur = Array("ı", "İ", "ğ", "Ğ", "ü", "Ü", "ş", "Ş", "ö", "Ö", "ç", "Ç")
ing = Array("i", "I", "g", "G", "u", "U", "s", "S", "o", "O", "c", "C")
For sat = 3 To Cells(Rows.Count, 1).End(3).Row
    VBA.Randomize: s = CInt(Int((900 * VBA.Rnd()) + 100)): deg = Cells(sat, 1)
    For k = 0 To 11: deg = Replace(Replace(deg, tur(k), ing(k)), " ", "."): Next
    Cells(sat, 7) = LCase(deg)
    Cells(sat, 8) = Split(LCase(deg), ".")(0) & s
Next
End Sub
Genişletmek için tıklayın ...

@Ömer Bey kodlar tam istediğim gibi çalışıyor teşekkür ederim.
Acaba H sütununda oluşturulan, sonu 3 haneli rakamla biten şifreleri sabitleyebilir miyiz?
Yani örneğin önce x satırlık bir veri varken bu kodu kullanarak istediğim veriler oluşturuluyor. Sonra x satırdan itibaren yeni satırlar ekleyip bu yeni veriler için yeniden hazırladığınız kodu kullandığımızda daha önce oluşturduğu 3 haneli rakamlar değişmese? Ve her seferinde böyle sadece yeni eklenenlere bu kodu uygulasa, daha önce üretilen sonu 3 haneli rakam içeren şifreler değişmese?
 
Oyla 0 Olumsuz oyla
Verdiğim kod'da Next satırının hemen üstündeki iki satırı aşağıdakilerle değiştirin.
VBA: 
[B][COLOR=rgb(43, 84, 44)]    If Cells(sat, 7) = "" Then [/COLOR][/B]Cells(sat, 7) = LCase(deg)
[B][COLOR=rgb(43, 84, 44)]    If Cells(sat, 8) = "" Then [/COLOR][/B]Cells(sat, 8) = Split(LCase(deg), ".")(0) & s
 
Oyla 0 Olumsuz oyla
Yanıt için giriş yapmanız veya üye olmanız gerekir.
Benzer Konular Popüler İçerikler Daha Fazlası
Geri
Üst