Rapor sayfasına verı aktar

[osmanli2]

Sayfa sun ve str lerde ki malzeme kod ve isimlerini aynı olanarı "b" ve "c" ye ve farklı olanları
kod sırasına göre araya ekleyek daha sonra tutarlarla ilgili verileri ilgili hücrelere yazan kodlara
ihtiyacım var.
Buara amaç; sun ve str sayfalarında ki tutar ve miktarları karşılaştırmak. Dikkat edilmesi gereken
sun ve str de tüm malzemeler birbirinin aynı değil. Aynı olmayanları kod sırasına göre bu sayafaya ekleyecek.
örnek ektedir.

 

[fedeal]

Sanırım oldu yalnız rapor alması 3-4 dakikayı buluyor rapor sayfasında sarı hücrede işlem bitince bildiriyor bekleyin makro çalıştıgı için excel kitlendi sanmayın ,iyi günler.

 

[osmanli2]

ustadım bu işlem istediğim gibi ama çok uzun sürüyor. süreyi kısaltmanın bir yolu varmıdır acaba. ayrıca emeğinize sağlık çok güzel bir çıkarmışsınız.

 

[fedeal]

işlemde ilk olarak sun sayfasından veriler alınıyor sonra str sayfasından sonra benzersiz liste oluşturuluyor sonra sun ve str sayfasından degerler getiriliyor kodlara göre sıralanıyor sonra liste sıra numarasına göre sıralanıyor. epey iş yapıyor işin şakası bir yana kısalabilir ama benim yapabildiğim bu,saygılar.

 

[fedeal]

Hızlandırdım galiba,

 

[janveljan]

Sn.fedealın düzenlediği dosya üzerinden çalıştım, alternatif bir çözüm, gayet hızlı, inceleyin lütfen.

 

[fedeal]

güzel çalışma bilgi paylaştıkça büyüyor teşekkürler sayın Janveljan.

 

[janveljan]

Ben teşekkür ederim.

 

[osmanli2]

siz üstandlarıma asıl ben teşekkür ederim. saygılar sunarım

 

[osmanli2]

ara toplam yaptırmak

Sayın Üstadlarım; ekli dosyada "b" sütunundaki kodların ilk 3 hanesi bir grubu temsil ediyor. buna göre rapor sayfası oluşturulurken bu kritere göre araya satır açıp örnektedki gibi alt toplam yaptırabilirmiyiz. Saygılar

 

[janveljan]

Kodları aşağıdakilerle değiştirip deneyin, alttoplarını alıyor.

Sub sırala()
Set ssun = Sheets("sun")
Set sstr = Sheets("str")
Set rap = Sheets("RAPOR")
For i = 4 To ssun.[A65536].End(xlUp).Row
For j = 1 To 4
rap.Cells(i + 2, j + 1) = ssun.Cells(i, j)
Next
Next
son = rap.[B65536].End(xlUp).Row - 3
For i = 4 To sstr.[A65536].End(xlUp).Row
rap.Cells(i + son, 2) = sstr.Cells(i, 1)
rap.Cells(i + son, 3) = sstr.Cells(i, 2)
rap.Cells(i + son, 6) = sstr.Cells(i, 3)
rap.Cells(i + son, 7) = sstr.Cells(i, 4)
Next
son = rap.[B65536].End(xlUp).Row
Range("B5:G" & son).Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlGuess
For i = son To 6 Step -1
    If rap.Cells(i, 2) = rap.Cells(i - 1, 2) Then
    rap.Cells(i - 1, 6) = rap.Cells(i, 6)
    rap.Cells(i - 1, 7) = rap.Cells(i, 7)
    Range("B" & i & ":G" & i).ClearContents
    End If
Next
Range("B5:G" & son).Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlGuess
son = rap.[B65536].End(xlUp).Row
For i = 6 To son
rap.Cells(i, 1) = Left(rap.Cells(i, 2), 3)
Next
Range("A5:G" & son).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(4, 5, 6, 7) _
        , Replace:=True, PageBreaks:=False, SummaryBelowData:=True
son = rap.[A65536].End(xlUp).Row
For i = 6 To son
If InStr(1, rap.Cells(i, 1), "Toplam") > 0 Then
Range("A" & i & ":G" & i).Font.Bold = True
Range("A" & i & ":G" & i).Interior.ColorIndex = 7
Else
Cells(i, 1).ClearContents
End If
Next

End Sub