AccessTr.neT

Halil hocam ANA LİSTE sayfası A sütunundaki veriler sırasız olursa bence hata olur diye düşünüyorum.
Sıralı olursa dictionary ilede olur diye sanıyorum.

kodlar ilk yıl değişikliğine göre işlem yapıyor yani veriler sırasız olursa sonuç da sırasız olur.

Hocam çok teşekkür ediyorum, küçük aksaklıklar hariç çok güzel olmuş, çalışmayı tekrar gönderiyorum gerekli eksiklikler ve açıklamaları çalışma kitabı içinde örnekleri ile birlikte açıklamaya çalıştım.

1-ANA LİSTEDEKİ VERİLER AZALDIĞI ZAMAN BİÇİEMLENDİRİLMİŞ BOŞ SATIRLAR SIRALAMA LİSTESİNDE GÖRÜNMEYE DEVAM EDİYOR.. ANCAK YAZICI ÇIKTISINDA NORMAL GÖRÜNÜYOR

2-ANA LİSTEDEKİ VERİLER ARTIRILDIĞINDA İSE SIRALAMA LİSTESİNE ATIYOR ANCAK YAZDIRMA ALANI BELİRNLENDİĞİ İÇİN YAZICI ÇIKTISINDA SONRASINI YAZDIRMIYOR.

3-KIRMIZI İLE GÖSTERİLEN HÜCRELER GÜZEL OLMUŞ BUNU BİRDE RENKLİ BİÇİM VEREBİLİRMİYİZ.  GÖSTERDİĞİM RENKTE VE AÇIK GRİDE OLABİLİR. ÇÜNKÜ YAZICI ÇIKTISINDA DİKKAT ÇEKMİYOR.

---

Hocam çok teşekkür ediyorum, küçük aksaklıklar hariç çok güzel olmuş, çalışmayı tekrar gönderiyorum gerekli eksiklikler ve açıklamalar içinde gösterdim.

1-ANA LİSTEDEKİ VERİLER AZALDIĞI ZAMAN BİÇİEMLENDİRİLMİŞ BOŞ SATIRLAR SIRALAMA LİSTESİNDE GÖRÜNMEYE DEVAM EDİYOR.. ANCAK YAZICI ÇIKTISINDA NORMAL GÖRÜNÜYOR

2-ANA LİSTEDEKİ VERİLER ARTIRILDIĞINDA İSE SIRALAMA LİSTESİNE ATIYOR ANCAK YAZDIRMA ALANI BELİRNLENDİĞİ İÇİN YAZICI ÇIKTISINDA SONRASINI YAZDIRMIYOR.

3-KIRMIZI İLE GÖSTERİLEN HÜCRELER GÜZEL OLMUŞ BUNU BİRDE RENKLİ BİÇİM VEREBİLİRMİYİZ.  GÖSTERDİĞİM RENKTE VE AÇIK GRİDE OLABİLİR. ÇÜNKÜ YAZICI ÇIKTISINDA DİKKAT ÇEKMİYOR.

sanırım daha önce yanlış yerden yeni konu gönder kısmından görderdim. onu taşıyabilirsiniz.

3. maddeden kastettiğiniz şeyi anlamadım???
diğer maddelerde de bahsettiğiniz soruna raslamadım
veri eklediğimde de sildiğimde de göstermesi gerektiği gibi gösterdi
aşağıdaki kodu dener misiniz
örnek aşağıdadır

Sub ListeAktarDz()

Dim SonStr As Long

Dim Sht As Worksheet, ShtHdf As Worksheet

Dim Dizi() As Variant, DiziKynk() As Variant

Dim DzStr As Long, DzStn As Byte

Dim RngBold As String, RngBoldDz() As String

SyfAktarSirala



Const sutun As Byte = 12

RngBold = "A2"

Set Sht = ThisWorkbook.Worksheets("TmpSrlSyf")

Set ShtHdf = ThisWorkbook.Worksheets("SIRALAMA")



SonStr = Sht.Cells(Sht.Rows.Count, "A").End(xlUp).Row



If SonStr < 2 Then GoTo son

If SonStr = 2 Then

    ShtHdf.Range("A2").Value = Sht.Range("A2").Value

    GoTo son

End If

TmpYnYil = Left(Sht.Range("A2"), 4)

DzStr = 0

DzStn = 0

StrSay = ((SonStr - 1) \ sutun) + 1 + Left(Sht.Range("A" & SonStr), 4) - Left(Sht.Range("A2"), 4) + 1

ReDim Dizi(StrSay, sutun)

DiziKynk = Sht.Range("A2:A" & SonStr)



i = 0

For StrX = LBound(DiziKynk) To UBound(DiziKynk)



If TmpYnYil <> Left(DiziKynk(StrX, 1), 4) Then

    DzStr = IIf(DzStn > 0, DzStr + 1, DzStr)

    DzStn = 0

    RngBold = RngBold & ", A" & DzStr + 2

    TmpYnYil = Left(DiziKynk(StrX, 1), 4)

End If

Dizi(DzStr, DzStn) = DiziKynk(StrX, 1)

DzStn = DzStn + 1



If DzStn = 12 Then

    DzStn = 0

    DzStr = DzStr + 1

End If

Next StrX

ShtHdf.Range("A2").Resize(UBound(Dizi, 1), sutun).Value = Dizi



SonStr = ShtHdf.Cells(ShtHdf.Rows.Count, "A").End(xlUp).Row + 1

ShtHdf.Range("A2").Resize(UBound(Dizi, 1), sutun).Borders.LineStyle = 1

ShtHdf.Range("A" & SonStr & ":L" & UBound(Dizi, 1) + 2).Clear



RngBoldDz = Split(RngBold, ",")



Dim Item As Variant

For Each Item In RngBoldDz

    ShtHdf.Range(Item).Font.Bold = True

    ShtHdf.Range(Item).Font.Color = vbRed

Next Item



son:

' On Error Resume Next

Sht.Cells.Clear

Erase Dizi: Set Sht = Nothing: Set ShtHdf = Nothing



MsgBox "bitti"

End Sub

Sıralama fonksiyonu bunun için dosyanıza  TmpSrlSyf adlı sayfa eklemelisiniz

Function SyfAktarSirala()

Dim SonStr As Long

Dim Sht As Worksheet, ShtTmp As Worksheet

Set Sht = ThisWorkbook.Worksheets("ANA LİSTE")

Set ShtTmp = ThisWorkbook.Worksheets("TmpSrlSyf")



ShtTmp.Cells.Clear

SonStr = Sht.Cells(Sht.Rows.Count, "A").End(xlUp).Row



Sht.Range("A:A").Copy Destination:=ShtTmp.Range("A1")

With ShtTmp

.Range("B2").Formula = "=INT(LEFT(A2,4))"

.Range("C2").Formula = "=INT(MID(A2,6,LEN(A2)))"

.Range("B2:C" & SonStr).FillDown

.Columns.Sort key1:=.Columns("B"), Order1:=xlAscending, Key2:=.Columns("C"), Order2:=xlAscending, Header:=xlYes

End With

End Function

Kusura bakmayın sizi çok uğraştırıyorum;
yaptığınız eklemeler için teşekkür ederim sıralama düzgün çalışıyor, ancak yazdırma sorunu aynen devam ediyor.
sanırım sıralama sayfasında sayfa önizleme görünümünde SATIR NUMARASI 1044 de sabitlenmiş veri eklesemde silsemde 1044 de kalıyor. böyle oluncada SATIR1044 den sonraki verileri yazıcıya göndermiyor.

3.sıradaki işlem ise Yılın ilk veriyi içeren hücresi (örnek: 2011/899, 2012/342 gibi) koyu kırmızı gösteriyor ya işte bunun yazıcı çıktısı alındığında dikkat çekmeyebileceğinden bunların sıralama sayfasında gösterdiğim renkte kodla biçimlendirilmesidir. (olmuyor ise renklendirme olmasa da olur.)

sizde çalıştığını söylemiştiniz, ne yazıkki bende aynı sorunlar devam ediyor. çalışma kitabı üzerinde düzenleme yapıp gönderebilirseniz çok minnettar olacağı.

28. mesajdaki dosyayı inceler misiniz?