Tarihe Ait Yıl-Ay-Hafta

[betoncu]

Merhaba,

A6 Sütunundan itibaren tarih girilince aynı satırda L sütununa yılı, M sütununa o tarihe ait ayı, N sütununa girilen tarihe ait ayın kaçıncı hafta olduğunu makro ile yazdırmak istiyorum.

Bunu formül ile yaptım fakat işlem ağırlaşıyor. (Çünkü bu formülleri 50.000 satıra kadar uzatmam gerekiyor. Bu nedenle hesaplama yaptığından işlem yaparken bekleme yapıyor.)


Örnek dosyayı ekte gönderiyorum. Yardımlarınız için teşekkür ederim..

 

[Trilenium]

Private Sub CommandButton1_Click()
For i = 6 To 500 ' sayıyı siz degiştirirsiniz...

Range("L" & i).Value = Year(Range("A" & i).Value)
Range("M" & i).Value = Month(Range("A" & i).Value)
Range("N" & i).Value = kacinci_hafta(Range("A" & i).Value)

Next i

End Sub
Function kacinci_hafta(Tarih As Date) As Byte
kacinci_hafta = Int((13 + Day(Tarih) - Weekday(Tarih - 1)) / 7)
End Function

 

[suleyman242]

Alternatif olsun

Private Sub CommandButton1_Click()
For i = 6 To [A65536].End(3).Row
Cells(i, "L").Value = Format(Cells(i, "A").Value, "yyyy")
Cells(i, "M").Value = Format(Cells(i, "A").Value, "mm")
Cells(i, "N").Value = Int(((13 - (Format(Cells(i, "A").Value - 1, "w")) + (Format(Cells(i, "A").Value, "dd"))) / 7))
Next
End Sub

 

[YUSUF44]

İlave olarak, veri giriş anında bu işin yapılmasını istiyorsanız aşağıdaki kodları ilgili sayfanın kod bölümüne yapıştırıp deneyiniz:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a6:a65536")) Is Nothing Then Exit Sub
If Target <> "" Then
Target.Offset(0, 11) = Year(Target)
Target.Offset(0, 12) = Month(Target)
Target.Offset(0, 13) = Int((13 - Weekday(Target - 1) + Day(Target)) / 7)
End If

End Sub

 

[betoncu]

Hepinize çok teşekkür ederim..

 

[betoncu]

İlave olarak, veri giriş anında bu işin yapılmasını istiyorsanız aşağıdaki kodları ilgili sayfanın kod bölümüne yapıştırıp deneyiniz:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a6:a65536")) Is Nothing Then Exit Sub
If Target <> "" Then
Target.Offset(0, 11) = Year(Target)
Target.Offset(0, 12) = Month(Target)
Target.Offset(0, 13) = Int((13 - Weekday(Target - 1) + Day(Target)) / 7)
End If

End Sub

YUSUF44 size bir sorum olacaktı. Yazdığımız tarih hücresini silince ilgili satırdaki yıl, ay ve hafta değerlerininde silinmesini istiyorum. Bunu nasıl yapabiliriz..

 

[YUSUF44]

Şu kodları dener misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a6:a65536")) Is Nothing Then Exit Sub
If Target = "" Then
Target.Offset(0, 11) = ""
Target.Offset(0, 12) = ""
Target.Offset(0, 13) = ""
Else
Target.Offset(0, 11) = Year(Target)
Target.Offset(0, 12) = Month(Target)
Target.Offset(0, 13) = Int((13 - Weekday(Target - 1) + Day(Target)) / 7)
End If

End Sub

 

[betoncu]

Şu kodları dener misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a6:a65536")) Is Nothing Then Exit Sub
If Target = "" Then
Target.Offset(0, 11) = ""
Target.Offset(0, 12) = ""
Target.Offset(0, 13) = ""
Else
Target.Offset(0, 11) = Year(Target)
Target.Offset(0, 12) = Month(Target)
Target.Offset(0, 13) = Int((13 - Weekday(Target - 1) + Day(Target)) / 7)
End If

End Sub

Çok teşekkür ederim. Bir konuda daha yardımınıza ihtiyacım var.
A sütunundaki hücrelere tarih dışında başka bir değer girince kod hata veriyor. Hata uyarısı vermesini nasıl engelleriz acaba?

 

[YUSUF44]

Şunu deneyin:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a6:a65536")) Is Nothing Then Exit Sub
If Target = "" Then
Target.Offset(0, 11) = ""
Target.Offset(0, 12) = ""
Target.Offset(0, 13) = ""
Else
If IsDate(Target) = True Then
Target.Offset(0, 11) = Year(Target)
Target.Offset(0, 12) = Month(Target)
Target.Offset(0, 13) = Int((13 - Weekday(Target - 1) + Day(Target)) / 7)
End If
End If
End Sub

 

[betoncu]

Şunu deneyin:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a6:a65536")) Is Nothing Then Exit Sub
If Target = "" Then
Target.Offset(0, 11) = ""
Target.Offset(0, 12) = ""
Target.Offset(0, 13) = ""
Else
If IsDate(Target) = True Then
Target.Offset(0, 11) = Year(Target)
Target.Offset(0, 12) = Month(Target)
Target.Offset(0, 13) = Int((13 - Weekday(Target - 1) + Day(Target)) / 7)
End If
End If
End Sub

Merhaba bir sıkıntı daha oldu. A sütununda tarih dışında bir veri girildiğinde bu sefer L,M,N sütunlarındaki eski değerler (yıl, ay, hafta) silinmeden kalıyor. Tarih dışında veri girildiğinde eski değerleri nasıl silebiliriz acaba?

 

[YUSUF44]

Bu sefer de şöyle olsun bari:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a6:a65536")) Is Nothing Then Exit Sub
If Target = "" Or IsDate(Target) = False Then
Target.Offset(0, 11) = ""
Target.Offset(0, 12) = ""
Target.Offset(0, 13) = ""
Else
Target.Offset(0, 11) = Year(Target)
Target.Offset(0, 12) = Month(Target)
Target.Offset(0, 13) = Int((13 - Weekday(Target - 1) + Day(Target)) / 7)
End If
End Sub

 

[betoncu]

Bu sefer de şöyle olsun bari:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a6:a65536")) Is Nothing Then Exit Sub
If Target = "" Or IsDate(Target) = False Then
Target.Offset(0, 11) = ""
Target.Offset(0, 12) = ""
Target.Offset(0, 13) = ""
Else
Target.Offset(0, 11) = Year(Target)
Target.Offset(0, 12) = Month(Target)
Target.Offset(0, 13) = Int((13 - Weekday(Target - 1) + Day(Target)) / 7)
End If
End Sub

Çok teşekkür ederim..