- Katılım
- 30 Mar 2019
- Mesajlar
- 1,921
- Excel Versiyonu
- Excel 2016
- Excel Sürümü
- 64 Bit
- Excel Dili
- Türkçe
Soruya nasıl bir başlık yazacağımı şaşırdım.
Soru aşağıdaki resimde açıklanmıştır.
Soru aşağıdaki resimde açıklanmıştır.
Ekli dosyalar
Ekli dosyalar
Private Sub CommandButton1_Click()
son = 8 ' cells(rows.count, "B").end(3).row
hucre = 4 'çıktı alınacak hucre
For i = 4 To son 'Satırlar için döngü
metin = Cells(i, 2)
uzunluk = Len(metin)
sifreli = ""
For k = 1 To uzunluk
parcala = Mid(metin, k, 1)
If IsNumeric(parcala) Then
sifreli = sifreli & "*"
GoTo chrDenCik
Else
For Z = 65 To 70 'A-F
If parcala = Chr(Z) Then
sifreli = sifreli & Chr(Z)
GoTo chrDenCik
End If
Next Z
For x = 97 To 102 'a-f
If parcala = Chr(x) Then
sifreli = sifreli & Chr(x)
GoTo chrDenCik
End If
Next x
End If
chrDenCik:
Next k
Cells(i, hucre) = LCase(sifreli)
Next i
End Sub
Çok teşekkür ediyorum...Merhaba , bir yerden başlamak lazım diyerek bir çözüm sağlamaya çalıştım. Daha makul çözümler elbette gelecektir.
İki farklı LAMBDA işlevi kullanarak çözüm denendi.
PowerQuery konusunda hiç deneyimim olmadı. Ama ilk fırsatımda bu konuyu öğrenmeye çalışacağım. O zaman bu dokumanı da detaylı incelerim...Bir de PowerQuery ile çözüm ekliyorum. Kaynak veri değişince YENİLE yapılması gerekmekte.
Rica ederim. Dediğim gibi bir yerden başlamak gerek. Muhtemelen yine sizden arşivlik bir çözüm gelecektir.@ezelk
Selamlar,
Çok teşekkür ediyorum...
Çok sevindiğimi söylemeliyim.
Bugün, bu soru için, ben de epeyce bir uğraştım. Sonunda,
** aklımın bir tarafındaki, BüyükHarf ve KüçükHarfin ÖZDEŞ olmalarına dayalı olarak, Harf ve Sayıların bulunduğu formülü hatırladım ve onu kullandım.
** sizin karakterleri bir hücreye yazıp, o hücreyi referans gösterdiğiniz yolu da kontrol amaçlı olarak kullandım.
Birazdan çözümü detaylı yazmaya çalışacağım.
BüyükHarf ve KüçükHarfin ÖZDEŞ olmalarına dayalı olarak, Harf ve Sayıların bulunduğu formülü de detaylı yazmaya çalışacağım. Becerebilirsem tabi ki...
Çok ama çok teşekkür ediyorum....
Bir teşekkür de Power Query için.
PowerQuery konusunda hiç deneyimim olmadı. Ama ilk fırsatımda bu konuyu öğrenmeye çalışacağım. O zaman bu dokumanı da detaylı incelerim...
Teşekkürlerimle...
Çok çok teşekkür ediyorum...Bu da makro çözümü.
=LET(m;KÜÇÜKHARF(PARÇAAL(B4;SIRALI(UZUNLUK(B4));1));c;DÜŞEYYIĞ(DAMGA(SIRALI(6;;97));DAMGA(SIRALI(10;;48)));XD;FİLTRE(m;DÇARP(--(m=DEVRİK_DÖNÜŞÜM(c));SIRALI(SATIRSAY(c))));METİNBİRLEŞTİR(;;;YERİNEKOY(XD;EĞERHATA(XD+0;"");"*")))
=LET(alan;B4:B8;a;PARÇAAL(KÜÇÜKHARF(alan);SIRALI(;MAK(UZUNLUK(alan)));1);b;--MAP(a;LAMBDA(x;YADA(ESAYIYSA(--x);EĞERHATA(ONDALIK(x;36)<16;0)*DEĞİL(ÖZDEŞ(KÜÇÜKHARF(x);BÜYÜKHARF(x))))));z;BYROW(EĞER(b;a;"");LAMBDA(s;ARALIKBİRLEŞTİR(s)));REDUCE(z;PARÇAAL("0123456789";SIRALI(10);1);LAMBDA(x;y;YERİNEKOY(x;y;"*"))))
Ekli dosyalar
Merhabalar formül uzadıkça dökülmeli kontrolü zor oluyor sürüklemeli oldu ama alternatif olsun.
Sub AYIKLAMA()
For sat = 4 To 8
deg = LCase(Cells(sat, 2))
For u = 1 To Len(deg)
k = Mid(deg, u, 1)
If Asc(k) < 48 Or Asc(k) > 102 Or _
(StrComp(LCase(k), UCase(k)) = 0 And Not IsNumeric(k)) Then _
deg = Replace(deg, k, ""): u = u - 1
If Len(deg) = u Then Exit For
Next u
For d = 1 To Len(deg)
k = Mid(deg, d, 1)
If k = Empty Then Exit For
If IsNumeric(k) Then
k = "*": ilk = IIf(d = 1, "", Mid(deg, 1, d - 1))
son = IIf(d = Len(deg), "", Mid(deg, d + 1, Len(deg)))
deg = ilk & k & son
ElseIf Asc(k) > 102 Then
k = "": ilk = IIf(d = 1, "", Mid(deg, 1, d - 1))
son = IIf(d = Len(deg) - 1, "", Mid(deg, d + 1, Len(deg)))
deg = ilk & k & son: d = d - 1
End If
Next d
Cells(sat, 4) = deg
Next sat
End Sub
Çok çok teşekkür ediyorum.Önce, REGX yöntemiyle daha kısa bir kod oluşturulabileceği kanaatinde olduğumu belirteyim (maalesef pek anlamıyorum).
Aşağıdaki kod da alternatif olsun. Sonuçlar D sütununa yazdırılır.
Önceki kodu arşivden çıkarıp aşağıdaki kodu eklerseniz, kodu daha kolay anlayabilirsiniz@okutkan
Selamlar,
Çok çok teşekkür ediyorum...
Makro fakiri olduğumdan nasıl bir yorum yapabilirim bilmiyorum. Ancak, alternatif bir çözüm olması açısından, denedim, sonuçlarını kontrol ettim ve arşivime ekledim çözümünüzü...
Teşekkürlerimle...
For i = 4 To 8
metin = LCase(Cells(i, 2))
uzunluk = Len(metin): sifreli = ""
For k = 1 To uzunluk
parcala = Mid(metin, k, 1)
If IsNumeric(parcala) Then
sifreli = sifreli & "*"
Else
For x = 97 To 102 'a-f
If parcala = Chr(x) Then
sifreli = sifreli & Chr(x)
Exit For
End If
Next x
End If
Next k
Cells(i, 3) = sifreli
Next i
Ekli dosyalar
Sayının Karakterlerini Hücrelere Dağıtma
|
|
Türkçe Karakterleri İngilizce Uyumlu Yapma
|
|
Hücredeki karakterleri benzersiz yapmak
|
|
Yanlış Tıklanan Hücreleri Kaldırma
|
|
Hücredeki Boşlukları Kaldırma
|