Virgül ile birleştirilmiş Tarih formatı.

[sward175]

Herkese Merhabalar,
Ekli dosyada A sütunda aralarında virgül bulunan tarihleri ;
1.10.2024, 1.11 2024, 1.12.2024 olan tarihleri Ekim 2024, Kasım 2024, Aralık 2024 formatında yazdırmak istiyorum.
Formül Ocak ... Aralık aylarını kapsamalı.
Saygılarımla,
sward175

 

[mustafa1205]

Merhabalar. Dosyanız Ek'tedr. İnceler misiniz?

 

[sward175]

Sayın: mustafa1205,
İlginize teşekkür ederim.
Aşağıdaki kod ile sayfalardan veri çekiyorum.
Çektiğim veriler 1.01.2024, 1.02.2024, 1.03.2024 gibi geliyor.
Bu koda nasıl bir ekleme yapalım ki Ocak 2024, Şubat 2024, Mart 2024 gibi gelsin.
Bu konuda aşağıdaki koda ekleme yaparsanız ben dosyamda tek seferde işlemi yapayım.
Sağlıcakla Kal.
sward175


Sub BorcSorgu()
Dim yil As String
Dim wsBorç As Worksheet
Dim wsYil As Worksheet
Dim aralik As Range
Dim isim As String
Dim i As Integer, j As Integer, k As Integer
Dim odemedigiAylar As String
Dim aranan As Range
Dim bulundu As Boolean

Set wsBorç = ThisWorkbook.Sheets("Borç Sorgu")
yil = wsBorç.Range("C1").Value
On Error Resume Next
Set wsYil = ThisWorkbook.Sheets(yil)
On Error GoTo 0

If wsYil Is Nothing Then
MsgBox yil & " yılı sayfası bulunamadı.", vbCritical
Exit Sub
End If

For i = 5 To 15 ' Borç Sorgu sayfasındaki B5:B15 aralığı
isim = wsBorç.Cells(i, 2).Value
odemedigiAylar = ""

Set aranan = wsYil.Range("B5:B15").Find(isim, LookIn:=xlValues, LookAt:=xlWhole)

If Not aranan Is Nothing Then
bulundu = True
For j = 5 To 16 ' 5'ten 16'ya kadar (E55)
If wsYil.Cells(4, j).Value <> "" And wsYil.Cells(aranan.Row, j).Value = "" Then
odemedigiAylar = odemedigiAylar & wsYil.Cells(3, j).Value & ", "
End If
Next j

If Len(odemedigiAylar) > 0 Then
odemedigiAylar = Left(odemedigiAylar, Len(odemedigiAylar) - 2) ' Son virgülü kaldır
End If
Else
bulundu = False
End If

 

[mustafa1205]

Mevcut kodda ufak bir güncelleme yaptım. A2:A5000 ve B2:B5000 arası çalışssın diye. Bu son dosyayı alın. Sizin sorunuza gelince kodunuza en sondaki "End Sub" dan önce
"Call TarihleriDonusturBelirliAralik" kodunu ilave etmeniz yeterli olacaktır. Bu kod dosyadaki kodu çağırır. işlemi yaptırır. Yani Dosyadaki kodu bir modüle kopyalamanız lazım

 

[sward175]

Sayın: mustafa1205,
İlgi ve önerinize teşekkür ederim.
Sağlıcakla kal.
sward175

 

[Korhan Ayhan]

Merhaba,

Ofis 365 sürümü için forumun arşivinde bulunması açısından formülü paylaşıyorum.

2 alternatif...

=IFERROR(TEXTJOIN(", ";;TEXT(TEXTSPLIT(A2;", ");"aaaa yyy"));"")

=IFERROR(TEXTJOIN(", ";;TEXT(FILTERXML("<root><item>"&SUBSTITUTE(A2;",";"</item><item>")&"</item></root>";"//item");"aaaa yyy"));"")

 

[sward175]

Sayın: Korhan Ayhan Üstadım.
Teşekkür ederim.
Saygılarımla,
sward175

 

[mustafa1205]

Umarım İşinize Yaramıştır Sayın Sward175.
Kolay gelsin. İyi Çalışmalar