Veri aktarma

[thecarow]

Merhaba;
Ekte bulunan dosyadaki "105" sayfasında bulunan ürünleri "ÜRÜNLER" sayfasındaki ilgili alanlara aktarmak istiyorum.Fakat bunu yaparken dikkat edilecek alan aynı üründen 5-6 vs. defa farklı alanlarda bulunuyor.Bunları tek bir satırda toplayıp toplamlarını alarak aktarmak istiyorum.Bunu formüllerle yaptığımda inanılmaz yavaş çalışıyor.Bu nedenle makro ile yapmanın daha sağlıklı olacağını düşündüm.Bu konuda nasıl bir çalışma yapılabilir.
Saygılarımla.

 

[İhsan Tank]

ürünler hangi sütunda
yabancı dilde yazmışsınız ondan anlamadım

 

[thecarow]

Hocam pardon;
F-L-M-P-S sütunlarındaki bilgileri alıp diğer sayfaya aktaracak.

 

[İhsan Tank]

onları zaten boyamışsınız ürünler'i tek'e düşeceğiz ya onu soruyorum.
toplayacağız sonradan ondan soruyorum

 

[thecarow]

Hocam kusura bakmayın tam anlayamadım.Ama şu şekilde tekrar belirteyim.Belirttiğim sütunlardaki bilgileri alıp diğer sayfaya aktaracak.Diğer sayfaya da zaten sıralı bir şekilde gidecek.Yani ilk sütuna F'deki veriler,2. sütuna L'deki veriler gibi.

 

[Orion1]

Dosyanız ektedir.

Option Base 1
Sub veri_aktar_topla()
Dim myarr(), list(), a As Long, i As Long, z As Object, n As Long
Dim sh As Worksheet, sure As Date, sure2 As Date, j As Long
sure = TimeValue(Now)
Sheets("ÜRÜNLER").Select
Application.ScreenUpdating = False
Range("A3:E65536").ClearContents
Set z = CreateObject("Scripting.dictionary")
For j = 2 To Worksheets.Count
    Set sh = Sheets(CStr(Sheets(j).Name))
    list = sh.Range("F2:S" & sh.Cells(1040000, "F").End(xlUp).Row).Value
    ReDim Preserve myarr(1 To 5, 1 To UBound(list))
    For i = 1 To UBound(list) + n
        If Not z.exists(list(i, 1)) Then
            n = n + 1
            z.Add list(i, 1), n
            myarr(1, n) = list(i, 1)
            myarr(2, n) = list(i, 7)
            myarr(3, n) = list(i, 8)
        End If
        myarr(4, z.Item(list(i, 1))) = myarr(4, z.Item(list(i, 1))) + list(i, 11)
        myarr(5, z.Item(list(i, 1))) = myarr(5, z.Item(list(i, 1))) + list(i, 14)
    Next
    Set sh = Nothing
Next
Erase list
ReDim Preserve myarr(1 To 5, 1 To n)
Range("A3").Resize(n, 5) = Application.Transpose(myarr)
Set z = Nothing: Erase myarr()
Application.ScreenUpdating = True
sure2 = TimeValue(Now) - sure
MsgBox "İşlem Başarı ile tamamlandı." & vbLf & "evrengizlen@hotmail.com" & _
vbLf & "SÜRE : " & sure2, vbOKOnly + vbInformation, Application.UserName
End Sub

 

[thecarow]

Hocam öncelikle teşekkürler;
Fakat o alandaki ürünlerden sadece 17. satıra kadar ürün gönderiyor.Ama diğer sayfada yüzlerce ürün var.Tüm ürünleri göndermiyor.

 

[thecarow]

Hocam ayrıca "ADJUSTED QTY" alanı doğru aktarmasına rağmen,"ADJUSTED COST" alanı farklı bir rakam gönderiyor.

 

[Orion1]

Hocam öncelikle teşekkürler;
Fakat o alandaki ürünlerden sadece 17. satıra kadar ürün gönderiyor.Ama diğer sayfada yüzlerce ürün var.Tüm ürünleri göndermiyor.

Ben yolladığınız örnek dosya üzerinde yaptım.
Oradaki benzersiz miktarı demekki 17 adetmiş 17 tane olmuş
başka sayfalarda var demişsiniz.Baştan söylemeliydiniz.
Şimdi tekrar uğraşacam.
diğer sayfalar nedir kaç sayfa vardır.
ilk 2 sayfa hariç diğer tüm sayfalarmı olacak.Konu belirsiz.Muğlak olmuş.

 

[thecarow]

Hocam kusura bakmayın ben yanlış anlattım.Asıl amacım şu;
105 sayfasında 3768. sütuna kadar ürünler var.Bu ürünlerden bazıları 2-3 sütunda da olabiliyor.Amacım 105 sayfasındaki ürünlerin hepsini "ÜRÜNLER" sayfasındaki ilgili alanlarına aktarmak.Fakat bunu yaparkende 1 kere olan ürünleri direk,2-3 veya daha fazla satırda olan ürünlerin "ADJUSTED QTY" ve "ADJUSTED COST" rakamlarını toplayarak diğer sayfaya aktarması.Örn. "TARİŞ LAVANTA KOL" ürünü sadece 1 kere yazılmış,bunun "ADJUSTED QTY" ve "ADJUSTED COST" rakamını direk olarak aktarması.Fakat "KOLESTON TÜP 8/0 AÇI" 2 farklı satırda da bulunmakta.Bu ürünün "ADJUSTED QTY" ve "ADJUSTED COST" rakamlarını toplayıp tek bir satırda yazması.Umarım anlatabilmişimidir.

 

[Orion1]

dosyayı güncelledim.2 numaralı mesajdan indirebilirsiniz.
ilk sayfa hariç diğer sayfaları içine alıp hepsini yapıyor.

 

[thecarow]

Hocam ben yanlış bir dosyamı indiriyorum bilmiyorum ama yine aynı dosya geliyor.

 

[thecarow]

Hocam anlatmak istediğime benzer bir dosya ektedir.

 

[Orion1]

Hocam ben yanlış bir dosyamı indiriyorum bilmiyorum ama yine aynı dosya geliyor.

Ayni dosya evet
ama kodlar değişti.
O dosyay sayfa ekleyin ve deneyin.

 

[thecarow]

Hocam gerçekten kafam durdu galiba ama bir türlü başaramadım.

 

[thecarow]

Hocam anlatmak istediğimi ekteki örnekde daha detaylı anlatmaya çalıştım.

 

[thecarow]

Hocam yardım edermisiniz