Koşula bağlı olarak tarihi gün olarak sıralı yazdırma

[muratcx]

Merhaba arkadaşlar tarihleri koşula bağlı olarak tek bir hücreye gün olarak yazdırmak mümkün müdür? ayrıntılı açıklama örnek dosyada verilmiştir.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub TARİH_BİRLEŞTİR()
    Dim X As Long, Y As Byte, SON As Byte
    
    Range("AH10:AH65536").ClearContents
    
    For X = 10 To Range("A65536").End(3).Row
        SON = Cells(X, "AH").End(1).Column
        For Y = 3 To 33
            If Cells(X, Y) > 0 Then
                Cells(X, "AH").NumberFormat = "@"
                If Cells(X, "AH") = Empty Then
                    Cells(X, "AH") = Format(Day(Cells(2, Y)), "00")
                Else
                    Cells(X, "AH") = Cells(X, "AH") & "." & Format(Day(Cells(2, Y)), "00")
                End If
                
                If Y = SON Then
                    Cells(X, "AH") = Cells(X, "AH") & "." & Format(Month(Cells(2, Y)), "00") & "." & Format(Year(Cells(2, Y)), "0000")
                End If
            End If
        Next
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Necdet]

Merhaba,

Fonksiyonlarla nasıl yapılır bilemiyorum ama, vba ile yapmak isterseniz aşağıdaki kodları deneyiniz.

Kodlar ilgili sayfanın kod bölümünde olmalı.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [C:AG]) Is Nothing Then Exit Sub
If Target.Row < 10 Then Exit Sub
Application.ScreenUpdating = False
Dim i As Integer
Range("AH" & Target.Row).ClearContents
For i = 3 To 33
    If Cells(Target.Row, i) > 0 Then
        If Cells(Target.Row, "AH") = "" Then
            Cells(Target.Row, "AH") = Format(i - 2, "00")
        Else
            Cells(Target.Row, "AH") = Cells(Target.Row, "AH") & "." & Format(i - 2, "00")
        End If
    End If
Next i
If Cells(Target.Row, "AH") <> "" Then Cells(Target.Row, "AH") = Cells(Target.Row, "AH") & "." & Format(Month([C2]), "00") & "." & Year([C2])
Application.ScreenUpdating = True
Son:
End Sub

 

[muratcx]

Sn Korhan hocam,Necdet hocam ayrı ayrı teşekkürlerimi borç bilirim. iyiki varsınız.

 

[muratcx]

Merhabalar yukarıdaki kod lar hücrelere rakamları manuel girince çalışıyor, veriler başka sayfadan formülle çekildiğinde çalışmıyor kodalar yeniden düzenlemek mümkünmüdür arkadaşlar