Hücre birleştir (AY YIL VE 1 CEYREK 2 CEYREK OLARAK) yardım lütfen

cengizank · 4 Şubat 2013

ay ve yıl tespiti yapılarak tarihin üstündeki hücreleri birleştirmek istiyorum

ekdeki dosyada daha geniş açıklama örneği var

şimdiden yapacağınız yardımlarınız için teşekkür ederim.

saygılarımla

nsertoglu · 4 Şubat 2013

' *** Aşağıdaki Kodları deneyin; kolay gelsin ***

Sub Düğme1_Tıklat()
' verilmesi gereken bilgiler:
s1 = "Sayfa1"
r1 = 15

' artık işlemler yapılıyor
Cells(r1, "b").Select
Selection.End(xlToRight).Select
aKK = ActiveCell.Address
aKc = ActiveCell.Column
acK = Mid(aKK, 2, InStr(2, aKK, "$") - 2)
acR = Val(Mid(aKK, InStr(2, aKK, "$") + 1, 7))
For k = 2 To aKc
Cells(r1, k).Select
trh = Cells(r1, k)
ay = Month(trh)
gn = Day(trh)
yl = Year(trh)
For kk = k + 1 To aKc
Cells(r1, kk).Select
If yl = Year(Cells(r1, kk)) Then

If ay = Month(Cells(r1, kk)) Then
syc = syc + 1
Else
mxA = kk - 1
GoSub aylar
GoSub ort_isl
Exit For
End If
Else
mxY = kk - 1
GoSub aylar
GoSub ort_isl
Exit For
End If
Next kk

Next k
' işlem tmm...
End

' alt yordamlar
aylar:
If ay = 1 Then ayi = "Ocak "
If ay = 2 Then ayi = "Şubat "
If ay = 3 Then ayi = "Mart "
If ay = 4 Then ayi = "Nisan "
If ay = 5 Then ayi = "Mayıs "
If ay = 6 Then ayi = "Haziran "
If ay = 7 Then ayi = "Temmuz "
If ay = 8 Then ayi = "Ağustos "
If ay = 9 Then ayi = "Eylül "
If ay = 10 Then ayi = "Ekim "
If ay = 11 Then ayi = "Kasım "
If ay = 12 Then ayi = "Aralık "

If ay = 1 Then ayc = "1 ÇEYREK "
If ay = 2 Then ayi = "1 ÇEYREK "
If ay = 3 Then ayi = "1 ÇEYREK "

If ay = 4 Then ayi = "2 ÇEYREK "
If ay = 5 Then ayi = "2 ÇEYREK "
If ay = 6 Then ayi = "2 ÇEYREK "

If ay = 7 Then ayi = "3 ÇEYREK "
If ay = 8 Then ayi = "3 ÇEYREK "
If ay = 9 Then ayi = "3 ÇEYREK "

If ay = 10 Then ayi = "4 ÇEYREK "
If ay = 11 Then ayi = "4 ÇEYREK "
If ay = 12 Then ayi = "4 ÇEYREK "

Return

secMerge:
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

Return

ort_isl:
tk1 = ayi & yl
tk2 = ayc & yl
rngg = Cells(r1 - 1, k).Address & ":" & Cells(r1 - 1, kk - 1).Address
Range(rngg).Select
GoSub secMerge
Cells(r1 - 1, k) = tk1
rngg = Cells(r1 - 2, k).Address & ":" & Cells(r1 - 2, kk - 1).Address
Range(rngg).Select
GoSub secMerge
Cells(r1 - 2, k) = tk2
k = kk - 1
Return
End Sub

cengizank · 4 Şubat 2013

Hocam

eline sağlık teşekkür ederim

lakin sonuç belli bir yerden sonra çok farklı oluyor

ayrıyeten tarih başlangıcı illa 01 den başlamayabilir mesala 13'den 18'den 20'den sonrada başlayabilir veya bitebilir (aylar tam olmayabilir başlangıç ve bitişde)

çıkan sonucla ilgili dosyayı tekrar ekliyorum

asıl olması gereken şekli renklendirdim

saygılarımla,

cengizank · 5 Şubat 2013

If ay = 1 Then ayc = "1 ÇEYREK "
If ay = 2 Then ayi = "1 ÇEYREK "
If ay = 3 Then ayi = "1 ÇEYREK "

If ay = 4 Then ayi = "2 ÇEYREK "
If ay = 5 Then ayi = "2 ÇEYREK "
If ay = 6 Then ayi = "2 ÇEYREK "

If ay = 7 Then ayi = "3 ÇEYREK "
If ay = 8 Then ayi = "3 ÇEYREK "
If ay = 9 Then ayi = "3 ÇEYREK "

If ay = 10 Then ayi = "4 ÇEYREK "
If ay = 11 Then ayi = "4 ÇEYREK "
If ay = 12 Then ayi = "4 ÇEYREK "

----------------------
yukarıdaki kodda

"ayi" yazan yerleri "ayc" olarak değiştirdim düzeldi

nsertoglu' na çok çok teşekkür ederim
nsertoglu 'nun göndermiş olduğu kod gayet iyi çalışıyor
lakin

1. 2. 3. olan ayların üstünüdeki 1 çeyrek olarak birleştirmesi gerekiyor kodda hepsine ayrı ayrı yazıyor
1. ayın üstüne 1. çeyrek
2. ayın üstüne 1. çeyrek
3. ayın üstüne 1. çeyrek

asıl olması gerek 3 ayın üstündeki hücrelerin tamamına 1 çeyrek 201? yazması gerekiyor yardımcı olacaklar için teşekkür ederim

Ömer · 5 Şubat 2013

Merhaba,

Sorudaki amaçınızı ben anlayamadım. Daha detaylı açıklarmısınız.

cengizank · 5 Şubat 2013

Ömer' Alıntı:
Merhaba,

Sorudaki amaçınızı ben anlayamadım. Daha detaylı açıklarmısınız.

Sayın Hocam;

en son gönderdiğim örnekde açıklamalı var

diyelimki
toplamda

Açıklamada noktaları dikkate almayın hizalama amaçlı kullandım
13. satır ("4. Çeyrek 2012............-.............1. Çeyrek 2013............-....................................2. Çeyrek 2013..................... devam ediyor)
14. satır (Aralık 2012................-......Ocak 2013-Şubat 2013-Mart 2013................-......Nisan 2013- Mayıs 2013 - Haziran 2013 devam ediyor)
15. satır tarih aralığı (13.12.2012 - 25.10.2013)
ve 200 küsür sütun kullanılıyor

15. satırda
13.12.2012 - 25.10.2013 tarih aralığı var vede bunlar gün gün hücrelerde yazılı iki tarih aralığı (200 küsür sutun yapıyor)

ve bu tarihler üstündeki hücrede 14. satırda

13.12.2012-31.12.2012 aralığında olana bir üsteki hücrelerin tamamı birleştirilerek Aralık 2012 yazılacak (aralık 2012 4. çeyreğe ait olduğu için 13. satırda aralık ayının üstündeki hücreler birleştirilerek 4. çeyrek 2012 yazacak)

daha sonra 2013 tarih aralığına geçtiğinde 1 ayın üstündeki hücreleri birleştirilerek Ocak 2013 sonra Şubat ayının üstündeki hücreler birleştirilerek Şubat 2013 yazacak sonra mart ayıda aynı olacak 3 ay tamamlanınca 14. satırda "Ocak 2013, Şubat 2013, Mart 2013" olan ayların bir üstündeki hücreleri yani 13. satırda "1 Çeyrek 2013" yazacak. diğer aylarda aynı olacak birde ayrı bir nokta başlangıç noktası ve bitiş noktasında aylar yarım olabilir 15.12.2013 bitiş ise 25.10.2013 gibi ona görede 13. satırda hangi çeyrekde bulunuyorsa yazılacak

mümkün olduğunca açıklamaya çalışdım klavyemin dili döndüğünce en son ekli örnek dosya renkli olarak örneği var saygılarımla

Ömer · 5 Şubat 2013

Bu açıklamaları konunun başını atlayarak mı yaptınız. Yada ben biryeri mi kaçıyorum.

Tarih aralığı berlileyeceksiniz ve bu aralık 4 - 5 ve 6. satırlara sizin yazdığınız format gibi yazılacak doğru mu?

Eğer doğru ise tarih aralığını nerden belirliyorsunuz. Bunun için kullandığınız hücre var mı?

cengizank · 6 Şubat 2013

Ömer' Alıntı:
Bu açıklamaları konunun başını atlayarak mı yaptınız. Yada ben biryeri mi kaçıyorum.

Tarih aralığı berlileyeceksiniz ve bu aralık 4 - 5 ve 6. satırlara sizin yazdığınız format gibi yazılacak doğru mu?

Eğer doğru ise tarih aralığını nerden belirliyorsunuz. Bunun için kullandığınız hücre var mı?

ömer hocam

tarih aralığı standart değil

herhangi bir tarihden başlayıp her hangi bir tarihde bitebilir

bu faaliyet çizelgesi olacak

her hangi bir yılın ortasında başından yada son ayından ve herhanngi bir günde başlayabilir ve sonraki yılın veya yılların herhangi bir tarihinde bitebilir

bu tarihlerin ayların yılları tespit edilerek üsteki hücrelere
o ay boyunca birleştirilecek.

örnek 05.12.2012-31.12.2012 yazan hücrelerin bir üstündeki hücreleri birleştirilerek birleştirilmiş hücreye Aralık 2012 yazacak ve diğer aylarıda böyle yapacak.

ve bu işlemleri yaparken 1 yıl 4 çeyrekden oluştuğundan dolayı

ocak 2013-şubat 2013-mart 2013 üstündeki hücreleri birleştirilerek 1. Çeyrek yazacak.

aylar diğer 3 ay içinde 2. çeyrek yazak (üç ayın üstündeki tüm hücreler birleştirilerek yapılacak)

tarih başlangıcı 4. çeyreği son ayın 20 başlayabilir. ve onun üstündeki hücreleri birleştirilerek "aralık 201?" ve ve bunun üstündeki hücrelerde birleştirilerek 4. çeyrek 201? yazılacak

ömer hocam ekli örneğe bakarsanız ve butona tıklağınızda ne demek istediğimi daha iyi anlayacaksınız

asi_kral · 6 Şubat 2013

Merhaba
Eki inceleyiniz_?

cengizank · 7 Şubat 2013

asi_kral_1967' Alıntı:
Merhaba
Eki inceleyiniz_?

hocam çok teşekkürler

harika olmuş

asi_kral · 7 Şubat 2013

cengizank' Alıntı:
hocam çok teşekkürler

harika olmuş

Kolay Gelsin.

Ömer · 7 Şubat 2013

Sonunda konuyu bende anladım

Alternatif olarak kullanabilirsiniz.

Kod:

Sub Duzenle()
 
    Dim i As Double, sont As Date, ilk As Integer, c As Range, d As Range
    Dim sut As Integer, bul As Date, a As Byte
    Dim k As Byte, b As Byte, t As Integer
 
    sut = Cells(15, Columns.Count).End(xlToLeft).Column: ilk = 2
 
    Application.ScreenUpdating = False
    Range(Cells(13, 2), Cells(14, sut)).Clear
 
    For i = Range("B15") To Cells(15, Columns.Count).End(xlToLeft).Value
        k = WorksheetFunction.RoundUp(Month(i) / 3, 0)
        sont = DateSerial(Year(i), Month(i) + 1, 0)
        If Format(Cells(15, sut), "mmmm.yyyy") = _
            Format(sont, "mmmm.yyyy") Then sont = Cells(15, sut): a = 1
        Set c = Rows(15).Find(sont, LookIn:=xlFormulas, LookAt:=xlWhole)
        If Not c Is Nothing Then
            With Range(Cells(14, ilk), Cells(14, c.Column))
                .Merge
                .Borders.LineStyle = 1
                .HorizontalAlignment = xlCenter
            End With
            Cells(14, ilk) = Format(sont, "mmmm.yyyy")
        End If
        If k <> b Then
            bul = DateSerial(Year(i), k * 3 + 1, 0)
            Set d = Rows(15).Find(bul, LookIn:=xlFormulas, LookAt:=xlWhole)
            If Not d Is Nothing Then t = d.Column Else t = sut
            With Range(Cells(13, ilk), Cells(13, t))
                .Merge
                .Borders.LineStyle = 1
                .HorizontalAlignment = xlCenter
            End With
            Cells(13, ilk) = k & " ÇEYREK " & Format(i, "yyyy")
        End If
        i = sont + 1: ilk = c.Column + 1: b = k
        If a = 1 Then Exit Sub
    Next i
    Application.ScreenUpdating = True
 
End Sub

.

cengizank · 7 Şubat 2013

asi kral 1967 ve Ömer hocam Allah ikinizden de razı olsun.
İlk fırsatta sizin hazırladığınız kodlarıda kullanacağım.

Yakında bu benzer ve yatay değil dikey ve farklı bir işlem sorum olacak.

Ömer hocam sizinki de harika olmuş. Deneme yaptım.

Saygılarımla,

asi kral 1967 hocam,
Ufak bir sıkıntı vardı ama düzelttim.
Kodda 10. ve 12. ayın if sorgusu olan satır üç satır sonraya alınca düzeldi.

Kod:

Case "10"
KL = Format(S1.Cells(15, STN), "mmmm.yyyy")
KL1 = "4. Çeyrek " & Format(S1.Cells(15, STN), "yyyy")
If .IsText(S1.Cells(15, STN - 1)) = False Then
If Month(S1.Cells(15, STN - 1)) = 11 Then
S1.Range(S1.Cells(14, STN - 1).Address & ":" & S1.Cells(14, STN).Address).Merge
S1.Range(S1.Cells(14, STN - 1).Address & ":" & S1.Cells(14, STN).Address) = KL
[COLOR="Red"]If Month(S1.Cells(15, STN)) >= 10 And Month(S1.Cells(15, STN)) <= 12 Then[/COLOR]
S1.Range(S1.Cells(13, STN - 1).Address & ":" & S1.Cells(13, STN).Address).Merge
S1.Range(S1.Cells(13, STN - 1).Address & ":" & S1.Cells(13, STN).Address) = KL1
ElseIf Month(S1.Cells(15, STN - 1)) = 10 Then
S1.Range(S1.Cells(13, STN - 1).Address & ":" & S1.Cells(13, STN).Address).Merge
S1.Range(S1.Cells(13, STN - 1).Address & ":" & S1.Cells(13, STN).Address) = KL1
End If: End If
Else
S1.Range(S1.Cells(14, STN).Address).Merge
End If

Düzeltilmiş
aşağıdadır

Kod:

Case "10"
KL = Format(S1.Cells(15, STN), "mmmm.yyyy")
KL1 = "4. Çeyrek " & Format(S1.Cells(15, STN), "yyyy")
If .IsText(S1.Cells(15, STN - 1)) = False Then
If Month(S1.Cells(15, STN - 1)) = 11 Then
S1.Range(S1.Cells(14, STN - 1).Address & ":" & S1.Cells(14, STN).Address).Merge
S1.Range(S1.Cells(14, STN - 1).Address & ":" & S1.Cells(14, STN).Address) = KL
S1.Range(S1.Cells(13, STN - 1).Address & ":" & S1.Cells(13, STN).Address).Merge
S1.Range(S1.Cells(13, STN - 1).Address & ":" & S1.Cells(13, STN).Address) = KL1
ElseIf Month(S1.Cells(15, STN - 1)) = 10 Then
[COLOR="Red"]If Month(S1.Cells(15, STN)) >= 10 And Month(S1.Cells(15, STN)) <= 12 Then[/COLOR]
S1.Range(S1.Cells(13, STN - 1).Address & ":" & S1.Cells(13, STN).Address).Merge
S1.Range(S1.Cells(13, STN - 1).Address & ":" & S1.Cells(13, STN).Address) = KL1
End If: End If
Else
S1.Range(S1.Cells(14, STN).Address).Merge
End If

cengizank · 8 Şubat 2013

Ömer hocam

sizin çalışmasınızla ilgili olarak

Farklı bir şekilde test ettiğimde, hız açısında 1 saniye daha hızlı. Fakat tarihleri formülle artırarak yaptığımızda hata veriyor

Hata olarak Dim değişken tanımlamasında "c As Date"
hatayı oluşturduğu yer Wiht boluğunda oluşuyor. Normal olarak yazdığımızda sıkıntı yok, eğer tarihi formülle arttırarak gider isek hata veriyor.

i = sont + 1: ilk = c.Column + 1: b = k burada sıkıntı yapıyor

saygılarımla

nsertoglu · 8 Şubat 2013

Emek veren sayın "Asi_Kral_1967" ve sayın "Ömer" e teşekkürler, ancak benim ilk kodlarımdaki gibi bazı sorunları var (hatasız kul olmaz).

Önceki kodlarımı aşağıdaki ile değiştiriniz; klasik programlama tekniği ile ve sorununuz çözüme kavuşsun(umarım her kontrolü yapabildim?!).

Sub Birleştir_NS()
Application.ScreenUpdating = False
stt = Time
' verilmesi gereken bilgiler:
S1 = "Sayfa1"
R1 = 15

' artık işlemler yapılıyor
Cells(R1, "b").Select
Selection.End(xlToRight).Select
aKK = ActiveCell.Address
aKc = ActiveCell.Column
acK = Mid(aKK, 2, InStr(2, aKK, "$") - 2)
acR = Val(Mid(aKK, InStr(2, aKK, "$") + 1, 7))

' eski formatın temizlenmesi
rngg = Cells((R1 - 2), "b").Address & ":" & Cells((R1 - 1), aKc).Address
Range(rngg).Select
Selection.Delete Shift:=xlToLeft

'yeni formata dönüşüm
For k = 2 To aKc + 1
Cells(R1, k).Select
trh = Cells(R1, k)
AY = Month(trh)
gn = Day(trh)
yl = Year(trh)

For kk = k + 1 To aKc + 1
Cells(R1, kk).Select
If yl = Year(Cells(R1, kk)) Then
If AY = Month(Cells(R1, kk)) Then
syc = syc + 1
Else
mxA = kk - 1
GoSub aylar
GoSub Ayl_isl
Exit For
End If
Else
mxY = kk - 1
GoSub aylar
GoSub Ayl_isl
Exit For
End If
Next kk

Next k ' Ay sınırı belirleme bitti.

' Çeyrek sınırları belirleme başladı
syc = 0 ' sayac sıfırlansın
For k = 2 To aKc + 1
Cells(R1, k).Select
trh = Cells(R1, k)
AY = Month(trh)
gn = Day(trh)
yl = Year(trh)
tk2 = ayc & yl
GoSub ceyrek
For kk = k + 1 To aKc + 1
Cells(R1, kk).Select
If yl = Year(Cells(R1, kk)) Then
If AY = Month(Cells(R1, kk)) Then
syc = syc + 1
Else
oncy = tk2
AY = Month(Cells(R1, kk))
GoSub ceyrek
If oncy <> tk2 Then
tk2 = oncy
mxA = kk - 1
GoSub Cey_isl
Exit For
End If
End If
Else
mxY = kk - 1
GoSub ceyrek
GoSub Cey_isl
Exit For
End If
Next kk

Next k
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
MsgBox " İşlem Tamamlandı.. " & stt & " - " & Time
End

' alt yordamlar
aylar:
' Ay ismi olarak ne görmek isteniyorsa yazılmalı
If AY = 1 Then ayi = "Ocak "
If AY = 2 Then ayi = "Şubat "
If AY = 3 Then ayi = "Mart "
If AY = 4 Then ayi = "Nisan "
If AY = 5 Then ayi = "Mayıs "
If AY = 6 Then ayi = "Haziran "
If AY = 7 Then ayi = "Temmuz "
If AY = 8 Then ayi = "Ağustos "
If AY = 9 Then ayi = "Eylül "
If AY = 10 Then ayi = "Ekim "
If AY = 11 Then ayi = "Kasım "
If AY = 12 Then ayi = "Aralık "
Return

ceyrek:
' Çeyrek (her 3 ay için) ismin ne görülmesi isteniyorsa yazılmalı
If AY >= 1 And AY <= 3 Then ayc = "1 ÇEYREK "
If AY >= 4 And AY <= 6 Then ayc = "2 ÇEYREK "
If AY >= 7 And AY <= 9 Then ayc = "3 ÇEYREK "
If AY >= 10 And AY <= 12 Then ayc = "4 ÇEYREK "
tk2 = ayc & yl
Return

secMergeY:
Selection.Merge
Selection.Borders.LineStyle = 1
Selection.Font.Bold = True
Selection.HorizontalAlignment = xlCenter
Return

Ayl_isl:
tk1 = ayi & yl
rngg = Cells(R1 - 1, k).Address & ":" & Cells(R1 - 1, kk - 1).Address
Range(rngg).Select
GoSub secMergeY
Cells(R1 - 1, k) = tk1
k = kk - 1
Return

Cey_isl:
rngg = Cells(R1 - 2, k).Address & ":" & Cells(R1 - 2, kk - 1).Address
Range(rngg).Select
GoSub secMergeY
Cells(R1 - 2, k) = tk2
k = kk - 1
Return

End Sub

cengizank · 8 Şubat 2013

Hocam sizin kodlarıda aldım.

Evde denemesini yapacağım. Bir konu hakkında üç tane çözüm örneği olmuş oldu

Teşekkürler

Ömer · 9 Şubat 2013

cengizank' Alıntı:
Ömer hocam

sizin çalışmasınızla ilgili olarak

Farklı bir şekilde test ettiğimde, hız açısında 1 saniye daha hızlı. Fakat tarihleri formülle artırarak yaptığımızda hata veriyor

Hata olarak Dim değişken tanımlamasında "c As Date"
hatayı oluşturduğu yer Wiht boluğunda oluşuyor. Normal olarak yazdığımızda sıkıntı yok, eğer tarihi formülle arttırarak gider isek hata veriyor.

i = sont + 1: ilk = c.Column + 1: b = k burada sıkıntı yapıyor

saygılarımla

Find kullanırken veri tipine göre find'in arama özelliklerini değiştirmek gerekir.
Find i kaldırarak bir örnek hazırladım. Aynı mantıkla çalışmaktadır.

Kod:

Sub Duzenle()
 
    Dim i As Double, sont As Date, ilk As Integer, x As Integer
    Dim sut As Integer, bul As Date, a As Byte, Wf As WorksheetFunction
    Dim k As Byte, b As Byte, t As Integer
 
    sut = Cells(15, Columns.Count).End(xlToLeft).Column: ilk = 2
    Set Wf = WorksheetFunction
 
    Application.ScreenUpdating = False
    Range(Cells(13, 2), Cells(14, sut)).Clear
 
    For i = Range("B15") To Cells(15, Columns.Count).End(xlToLeft).Value
        k = WorksheetFunction.RoundUp(Month(i) / 3, 0)
        sont = DateSerial(Year(i), Month(i) + 1, 0)
        If Format(Cells(15, sut), "mmmm.yyyy") = _
            Format(sont, "mmmm.yyyy") Then sont = Cells(15, sut): a = 1
        If Wf.CountIf(Rows(15), sont) > 0 Then
            x = Wf.Match(CDbl(sont), Rows(15), 0)
            With Range(Cells(14, ilk), Cells(14, x))
                .Merge
                .Borders.LineStyle = 1
                .HorizontalAlignment = xlCenter
            End With
            Cells(14, ilk) = Format(sont, "mmmm.yyyy")
        End If
        If k <> b Then
            bul = DateSerial(Year(i), k * 3 + 1, 0)
            If Wf.CountIf(Rows(15), bul) > 0 Then
                t = Wf.Match(CDbl(bul), Rows(15), 0)
            Else
                t = sut
            End If
            With Range(Cells(13, ilk), Cells(13, t))
                .Merge
                .Borders.LineStyle = 1
                .HorizontalAlignment = xlCenter
            End With
            Cells(13, ilk) = k & " ÇEYREK " & Format(i, "yyyy")
        End If
        i = sont + 1: ilk = x + 1: b = k
        If a = 1 Then Exit Sub
    Next i
    Application.ScreenUpdating = True
 
End Sub

cengizank · 11 Şubat 2013

Ömer ve nsertoglu Hocam;

Kodlar gayet iyi çalışıyor.

Teşekkürler,

Saygılarımla.

assenucler · 11 Şubat 2013

Sayın cengizank,

Katkı veren üstadlara teşekkürler.

Acaba, dosyanızın en son çalışan şeklini ekleyebilir misiniz?

cengizank · 12 Şubat 2013

assenucler' Alıntı:
Sayın cengizank,

Katkı veren üstadlara teşekkürler.

Acaba, dosyanızın en son çalışan şeklini ekleyebilir misiniz?

üç tane örneğide ekledim

Hücre birleştir (AY YIL VE 1 CEYREK 2 CEYREK OLARAK) yardım lütfen

cengizank

Ekli dosyalar

nsertoglu

cengizank

Ekli dosyalar

cengizank

Ömer

Moderatör

cengizank

Ekli dosyalar

Ömer

Moderatör

cengizank

Ekli dosyalar

asi_kral

Özel Üye

Ekli dosyalar

cengizank

asi_kral

Özel Üye

Ömer

Moderatör

cengizank

cengizank

nsertoglu

cengizank

Ömer

Moderatör

cengizank

assenucler

cengizank

Ekli dosyalar